home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / IMDB_tool_2054503182007.psc / frmMain.frm < prev    next >
Text File  |  2007-02-10  |  12KB  |  387 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  4. Begin VB.MDIForm frmMain 
  5.    BackColor       =   &H8000000C&
  6.    Caption         =   "IMDB Tool"
  7.    ClientHeight    =   7680
  8.    ClientLeft      =   2760
  9.    ClientTop       =   2220
  10.    ClientWidth     =   8235
  11.    Icon            =   "frmMain.frx":0000
  12.    LinkTopic       =   "MDIForm1"
  13.    OLEDropMode     =   1  'Manual
  14.    Begin MSComctlLib.Toolbar wnds 
  15.       Align           =   1  'Align Top
  16.       Height          =   360
  17.       Left            =   0
  18.       TabIndex        =   2
  19.       Top             =   360
  20.       Visible         =   0   'False
  21.       Width           =   8235
  22.       _ExtentX        =   14526
  23.       _ExtentY        =   635
  24.       ButtonWidth     =   1138
  25.       ButtonHeight    =   582
  26.       Appearance      =   1
  27.       Style           =   1
  28.       TextAlignment   =   1
  29.       ImageList       =   "imgs"
  30.       _Version        =   393216
  31.    End
  32.    Begin VB.Timer Timer1 
  33.       Interval        =   2000
  34.       Left            =   4440
  35.       Top             =   2820
  36.    End
  37.    Begin MSComctlLib.ImageList imgs 
  38.       Left            =   1800
  39.       Top             =   2640
  40.       _ExtentX        =   1005
  41.       _ExtentY        =   1005
  42.       BackColor       =   -2147483633
  43.       ImageWidth      =   16
  44.       ImageHeight     =   16
  45.       MaskColor       =   16711935
  46.       _Version        =   393216
  47.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  48.          NumListImages   =   3
  49.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  50.             Picture         =   "frmMain.frx":1042
  51.             Key             =   ""
  52.          EndProperty
  53.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  54.             Picture         =   "frmMain.frx":1394
  55.             Key             =   ""
  56.          EndProperty
  57.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  58.             Picture         =   "frmMain.frx":16E6
  59.             Key             =   ""
  60.          EndProperty
  61.       EndProperty
  62.    End
  63.    Begin MSWinsockLib.Winsock imdbHTML 
  64.       Left            =   360
  65.       Top             =   1560
  66.       _ExtentX        =   741
  67.       _ExtentY        =   741
  68.       _Version        =   393216
  69.    End
  70.    Begin MSComctlLib.StatusBar sb1 
  71.       Align           =   2  'Align Bottom
  72.       Height          =   255
  73.       Left            =   0
  74.       TabIndex        =   0
  75.       Top             =   7425
  76.       Width           =   8235
  77.       _ExtentX        =   14526
  78.       _ExtentY        =   450
  79.       _Version        =   393216
  80.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  81.          NumPanels       =   3
  82.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  83.             AutoSize        =   2
  84.             Object.Width           =   159
  85.             MinWidth        =   2
  86.          EndProperty
  87.          BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  88.             AutoSize        =   2
  89.             Object.Width           =   159
  90.             MinWidth        =   2
  91.          EndProperty
  92.          BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  93.             AutoSize        =   2
  94.             Object.Width           =   159
  95.             MinWidth        =   2
  96.          EndProperty
  97.       EndProperty
  98.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  99.          Name            =   "Tahoma"
  100.          Size            =   8.25
  101.          Charset         =   0
  102.          Weight          =   400
  103.          Underline       =   0   'False
  104.          Italic          =   0   'False
  105.          Strikethrough   =   0   'False
  106.       EndProperty
  107.    End
  108.    Begin MSComctlLib.Toolbar Toolbar1 
  109.       Align           =   1  'Align Top
  110.       Height          =   360
  111.       Left            =   0
  112.       TabIndex        =   1
  113.       Top             =   0
  114.       Width           =   8235
  115.       _ExtentX        =   14526
  116.       _ExtentY        =   635
  117.       ButtonWidth     =   609
  118.       ButtonHeight    =   582
  119.       Appearance      =   1
  120.       Style           =   1
  121.       ImageList       =   "imgs"
  122.       _Version        =   393216
  123.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  124.          NumButtons      =   2
  125.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  126.             Object.ToolTipText     =   "Get movie info with IMDB code"
  127.             ImageIndex      =   1
  128.          EndProperty
  129.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  130.             Object.ToolTipText     =   "Search for movies"
  131.             ImageIndex      =   2
  132.          EndProperty
  133.       EndProperty
  134.    End
  135.    Begin VB.Menu mnuFile 
  136.       Caption         =   "&File"
  137.       Begin VB.Menu mnulc 
  138.          Caption         =   "&Load Codes"
  139.          Visible         =   0   'False
  140.       End
  141.       Begin VB.Menu mnuDC 
  142.          Caption         =   "Dump Codes"
  143.          Visible         =   0   'False
  144.       End
  145.       Begin VB.Menu mnuExit 
  146.          Caption         =   "E&xit"
  147.       End
  148.    End
  149.    Begin VB.Menu mnuMovie 
  150.       Caption         =   "&Movie"
  151.       Begin VB.Menu mnuBID 
  152.          Caption         =   "&Get Movie info By ID..."
  153.       End
  154.       Begin VB.Menu mnuSrch 
  155.          Caption         =   "&Search Database..."
  156.       End
  157.    End
  158.    Begin VB.Menu mnuTools 
  159.       Caption         =   "&View"
  160.       Begin VB.Menu mnuVSC 
  161.          Caption         =   "Stretch Cover"
  162.          Visible         =   0   'False
  163.       End
  164.       Begin VB.Menu mnuVHIS 
  165.          Caption         =   "&History"
  166.       End
  167.       Begin VB.Menu mnuBGCOL 
  168.          Caption         =   "&Background Color"
  169.       End
  170.    End
  171.    Begin VB.Menu mnuHelp 
  172.       Caption         =   "&Help"
  173.       Begin VB.Menu mnuAbout 
  174.          Caption         =   "&About"
  175.       End
  176.    End
  177. End
  178. Attribute VB_Name = "frmMain"
  179. Attribute VB_GlobalNameSpace = False
  180. Attribute VB_Creatable = False
  181. Attribute VB_PredeclaredId = True
  182. Attribute VB_Exposed = False
  183. Public HTML_SOURCE As String
  184. Public Function GetPageSource(sPage As String) As String
  185. 'connect to IMDB Server
  186.  
  187. Dim HEADERS As String
  188.  
  189. AddLogEvent "Attempting to connect to IMDB"
  190. If imdbHTML.State <> sckClosed Then imdbHTML.Close
  191.  
  192. imdbHTML.Connect IMDB_HostName, 80
  193.  
  194. 'WAIT FOR A CONNECTION XXXXXXXXXXXXXXXXX
  195. Do
  196.     Select Case imdbHTML.State
  197.         Case sckConnecting, sckConnected, sckResolvingHost, sckHostResolved, sckConnectionPending
  198.         Case Else
  199.             If imdbHTML.State <> sckClosed Then imdbHTML.Close
  200.             AddLogEvent "Could not connect to IMDB!"
  201.             Exit Function
  202.             'ERROR
  203.     End Select
  204. DoEvents
  205. Loop While imdbHTML.State <> sckConnected
  206. 'WAIT FOR A CONNECTION XXXXXXXXXXXXXXXXX
  207.  
  208. 'WE ARE CONNECTED XXXXXXXXXXXXXXXXXXXXXX
  209. HTML_SOURCE = ""
  210. AddLogEvent "Connected to IMDB"
  211.  
  212. HEADERS = "GET " & sPage & " HTTP/1.1" & vbCrLf & _
  213.     "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*" & vbCrLf & _
  214.     "Accept -Language: en -us" & vbCrLf & _
  215.     "Accept -Encoding: gzip , deflate" & vbCrLf & _
  216.     "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.1.4322)" & vbCrLf & _
  217.     "Host: " & imdbHTML.RemoteHost & vbCrLf & _
  218.     "Content-Length: 1" & vbCrLf & _
  219.     "Connection: Close" & vbCrLf & vbCrLf
  220.  
  221.  
  222. 'SEND HEADERS XXXXXXXXXXXXXXXXXXXXXXXXXX
  223. If imdbHTML.State = sckConnected Then
  224.     imdbHTML.SendData HEADERS
  225.     DoEvents
  226. Else
  227.     AddLogEvent "Unknown Error, Abort"
  228.     Exit Function
  229. End If
  230.  
  231. Do
  232. 'Getting data from server
  233. DoEvents
  234. Loop While imdbHTML.State = sckConnected
  235. GetPageSource = HTML_SOURCE
  236.  
  237. AddLogEvent "Operation Completed"
  238.  
  239. End Function
  240.  
  241. Private Sub imdbHTML_DataArrival(ByVal bytesTotal As Long)
  242. Dim TEMP_DATA As String
  243. imdbHTML.GetData TEMP_DATA
  244.  
  245. DoEvents
  246. HTML_SOURCE = HTML_SOURCE & TEMP_DATA
  247. DoEvents
  248. sb1.Panels(1).Text = "Getting HTML Source: " & Len(HTML_SOURCE) & " Bytes "
  249. End Sub
  250.  
  251.  
  252. Private Sub MDIForm_Load()
  253. Init
  254. BG_COL = &H8000000C
  255. End Sub
  256.  
  257. Private Sub MDIForm_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
  258. On Error GoTo dontcont:
  259.  
  260. 'When a file is dragged onto the form, find IMDB codes in it and
  261. 'automatically download movie information
  262.  
  263. Dim FILENAME As String
  264. Dim IMDBCODE1 As String
  265. Dim HTMLBUF As String
  266.  
  267. FILENAME = Data.Files(1)
  268.  
  269. If Trim(FILENAME) = "" Then
  270.     Exit Sub
  271. End If
  272.  
  273. 'deal with files less than 2 megs
  274. If FileLen(FILENAME) > (2000000) Then
  275.     AddLogEvent "Dragged File to Big!"
  276.     Exit Sub
  277. End If
  278.  
  279. Dim FILEBUF As String
  280. FILEBUF = Space$(FileLen(FILENAME))
  281. Open FILENAME For Binary Access Read As #1
  282.     Get #1, , FILEBUF
  283. Close #1
  284.  
  285. Dim FBSPL() As String
  286. FBSPL = Split(FILEBUF, "tt", , vbTextCompare)
  287. If UBound(FBSPL) > 0 Then
  288.     For i = 1 To UBound(FBSPL)
  289.         Select Case Left(FBSPL(i), 1)
  290.             Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
  291.                 'valid imdb code
  292.                 IMDBCODE1 = "tt" & Left(FBSPL(i), 7)
  293.                 AddLogEvent "Found IMDB Code..."
  294.                     AddQueueEntry IMDBCODE1
  295.                     'HTMLBUF = frmMain.GetPageSource("/title/" & IMDBCODE1 & "/")
  296.                     'ParseTitlePage HTMLBUF
  297.  
  298.                 Exit Sub
  299.         End Select
  300.     Next
  301. Else
  302.     AddLogEvent "No IMDB code in file!"
  303.     Exit Sub
  304. End If
  305.  
  306. Exit Sub
  307. dontcont:
  308. AddLogEvent "File Error!"
  309. End Sub
  310.  
  311. Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  312. SaveHistory
  313. End Sub
  314.  
  315. Private Sub mnuAbout_Click()
  316. MsgBox "IMDB Data tool" & vbCrLf & vbCrLf & "Programmed by TecCRC" & vbCrLf & "Icons by Stock Sources" & vbCrLf & vbCrLf & "A tool to download movie information" & vbCrLf & _
  317.                                                                                                                            "from the Internet Movie Database and" & vbCrLf & _
  318.                                                                                                                            "display it in this nice little interface" & vbCrLf & vbCrLf & _
  319.                                                                                                                            "Codes Version: " & CV & vbCrLf & "App Version: " & CODES_VER, vbInformation, "About IMDB Tool"
  320. End Sub
  321.  
  322. Private Sub mnuBGCOL_Click()
  323. Dim DDD() As String
  324.  
  325. Dim dd As String
  326. dd = InputBox("Enter an RGB Value: EX: 000,000,000", "Change", "100,150,120")
  327. If dd <> "" Then
  328.     DDD = Split(dd, ",")
  329.     BG_COL = RGB(DDD(0), DDD(1), DDD(2))
  330. End If
  331.  
  332. End Sub
  333.  
  334. Private Sub mnuBID_Click()
  335. frmInputCode.Show
  336. End Sub
  337.  
  338. Private Sub mnuDC_Click()
  339. DumpCodes
  340. End Sub
  341.  
  342. Private Sub mnuExit_Click()
  343. Unload Me
  344. End
  345. End Sub
  346.  
  347. Private Sub mnumdd_Click()
  348. For i = 133093 To 134093
  349.     AddQueueEntry "tt" & "0" & i
  350. Next
  351. End Sub
  352.  
  353. Private Sub mnulc_Click()
  354. LoadCodes
  355. End Sub
  356.  
  357.  
  358.  
  359. Private Sub mnuSrch_Click()
  360. frmSearch.Show
  361. End Sub
  362.  
  363. Private Sub mnuVHIS_Click()
  364. frmHistory.Show
  365. End Sub
  366.  
  367. Private Sub Timer1_Timer()
  368. sb1.Panels(3).Text = GetQueues() & " Queued"
  369. ExecuteQueue
  370. End Sub
  371.  
  372. Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  373. Select Case Button.Index
  374.     Case 1 'Movie info by Code
  375.         frmInputCode.Show
  376.     Case 2 'Search
  377.         frmSearch.Show
  378. End Select
  379. End Sub
  380.  
  381. Private Sub wnds_ButtonClick(ByVal Button As MSComctlLib.Button)
  382.  
  383.         WNDWS(Button.Tag).pFrm.SetFocus
  384.         
  385.  
  386. End Sub
  387.