📄 frmsearch.frm
字号:
VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "Msinet.ocx"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form frmSearch
BackColor = &H00F8EADF&
BorderStyle = 0 'None
Caption = "YouTube Video Search Utility"
ClientHeight = 5415
ClientLeft = 0
ClientTop = 75
ClientWidth = 8175
Icon = "frmSearch.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5415
ScaleWidth = 8175
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin SHDocVwCtl.WebBrowser WebBrowser1
Height = 1800
Left = 5520
TabIndex = 11
Top = 2640
Width = 2355
ExtentX = 4154
ExtentY = 3175
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End
Begin VB.CommandButton cmdPreview
Caption = "Preview"
Height = 255
Left = 6240
TabIndex = 10
ToolTipText = "Get Video Preview and its Description."
Top = 4920
Width = 855
End
Begin VB.ListBox l1
Height = 2205
Left = 3720
TabIndex = 5
Top = 2520
Visible = 0 'False
Width = 1455
End
Begin VB.ComboBox cmbQuery
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 315
Left = 240
TabIndex = 4
Top = 1800
Width = 3375
End
Begin VB.ListBox l2
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
ForeColor = &H00000040&
Height = 2175
Left = 240
TabIndex = 0
ToolTipText = "All Results will be Displayed here. Select title to display its Image."
Top = 2520
Width = 5055
End
Begin InetCtlsObjects.Inet Inet1
Left = 8640
Top = 5280
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.Image Image5
Height = 855
Left = 960
Picture = "frmSearch.frx":1244A
Stretch = -1 'True
Top = 480
Width = 855
End
Begin VB.Shape Shape1
BorderColor = &H00C27C42&
Height = 5415
Left = 0
Top = 0
Width = 8175
End
Begin VB.Image Image3
Height = 285
Left = 7440
Picture = "frmSearch.frx":16BD0
Stretch = -1 'True
Top = 45
Width = 615
End
Begin VB.Image Image1
Height = 3015
Left = 5400
Picture = "frmSearch.frx":1904F
Stretch = -1 'True
Top = 2280
Width = 2595
End
Begin VB.Image btnSearch
Height = 375
Left = 3720
Picture = "frmSearch.frx":1A3FA
Stretch = -1 'True
Top = 1750
Width = 495
End
Begin VB.Label Label6
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00EF9F5D&
Caption = ">>"
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1320
TabIndex = 9
ToolTipText = "Next"
Top = 4920
Width = 975
End
Begin VB.Label Label5
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00EF9F5D&
Caption = "OK"
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 4680
TabIndex = 8
Top = 4920
Width = 735
End
Begin VB.Label Label4
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00EF9F5D&
Caption = "Cancel"
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 3480
TabIndex = 7
ToolTipText = "Cancel"
Top = 4920
Width = 975
End
Begin VB.Label Label2
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00EF9F5D&
Caption = "<<"
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 240
TabIndex = 6
ToolTipText = "Previous"
Top = 4920
Width = 975
End
Begin VB.Image Image2
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Height = 495
Left = 1920
Picture = "frmSearch.frx":1A8FC
Stretch = -1 'True
Top = 720
Width = 5175
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Video Image"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 5520
TabIndex = 3
Top = 2280
Width = 2295
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Enter Search Query: (e.g. 3d max tutorial)"
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 240
TabIndex = 2
Top = 1560
Width = 4335
End
Begin VB.Label lblFound
BackStyle = 0 'Transparent
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 375
Left = 4320
TabIndex = 1
Top = 1800
Width = 3735
End
Begin VB.Image Image4
Height = 375
Left = 0
Stretch = -1 'True
Top = 0
Width = 8175
End
End
Attribute VB_Name = "frmSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'if Your VB6.0 IDE is showing Compiler error here (Because you Might be using IE7+)
'Just Press Ctl+T and then Browse. In Open Dialog box n past >>>>>>shdocvw.dll<<<<<<
'Press Apply n OK. Done..!!!
Private Sub btnSearch_Click()
lblFound.Caption = "Searching...."
SearchEngine cmbQuery.Text, 1, Inet1
SaveSetting App.EXEName, "Settings", "Query", cmbQuery.Text
End Sub
Private Sub btnSearch_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnSearch.BorderStyle = 1
End Sub
Private Sub btnSearch_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnSearch.BorderStyle = 0
End Sub
Private Sub cmdPreview_Click()
frmPreview.Show 1
End Sub
'Coded By Rajendra Khope, Pune, India
'App Name: YoutubeVideoDownloader
'Use: Software to Serach and Download YouTube Video.
'
'For more Info: http://youtube.com
'
'Email : bkrajendra@gmail.com
Private Sub Form_Load()
'sbrStat.Panels(1).Width = sbrStat.Width - sbrStat.Panels(2).Width
On Error Resume Next
Image4.Picture = frmMain.Image4.Picture
Image3.Picture = frmMain.Image2.Picture
cmbQuery.AddItem GetSetting(App.EXEName, "Settings", "Query")
'THis Displays Web Browser with blank page with no scrollebars, very nice technique to
'display images directly from the web on the Vb form.
'if Your VB6.0 IDE is showing Compiler error here (Because you Might be using IE7+)
'Just Press Ctl+T and then Browse. In Open Dialog box n past shdocvw.dll
'Press Apply n OK. Done..!!!
WebBrowser1.Navigate ("about:<html><body scroll='no'></body></html>")
intPagesCntr = 1
'If Err.Number > 0 Then
'MsgBox Err.Number & " " & Err.Description
'End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image3.Picture = frmMain.clb.Picture
End Sub
Private Sub Image3_Click()
Me.Hide
End Sub
Private Sub Image3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image3.Picture = frmMain.clr.Picture
End Sub
Private Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
formdrag Me
End Sub
Private Sub Image4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image3.Picture = frmMain.clb.Picture
End Sub
Private Sub l2_Click()
On Error GoTo errr
'Show Curresponding Image
'single WebControl :)
Dim imgsrc As String
imgsrc = "http://i1.ytimg.com/vi/" & l1.List(l2.ListIndex) & "/default.jpg"
WebBrowser1.Navigate "about:<html><body scroll='no' topmargin=0 leftmargin=0><img src='" & imgsrc & "' width=153></img></body></html>"
' VideoUser
Exit Sub
errr:
MsgBox Err.Description
End Sub
Private Sub l2_DblClick()
If (l1.List(l2.ListIndex)) = "" Then
MsgBox "Nothing Selected!"
Else
frmMain.Text1.Text = "http://youtube.com/watch?v=" & l1.List(l2.ListIndex)
Me.Hide
End If
End Sub
Private Sub l2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
l2.ToolTipText = l2.Text
End Sub
Private Sub Label2_Click()
intPagesCntr = intPagesCntr - 1
'Get Previeous Search Page
If intPagesCntr >= 1 Then
SearchEngine cmbQuery.Text, intPagesCntr, Inet1
Else
intPagesCntr = 1
End If
End Sub
Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label2.BorderStyle = 1
End Sub
Private Sub Label2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label2.BorderStyle = 0
End Sub
Private Sub Label4_Click()
Me.Hide
End Sub
Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label4.BorderStyle = 1
End Sub
Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label4.BorderStyle = 0
End Sub
Private Sub Label5_Click()
If (l1.List(l2.ListIndex)) = "" Then
MsgBox "Nothing Selected!"
Else
frmMain.Text1.Text = "http://youtube.com/watch?v=" & l1.List(l2.ListIndex)
Me.Hide
End If
End Sub
Private Sub Label5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label5.BorderStyle = 1
End Sub
Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label5.BorderStyle = 0
End Sub
Private Sub Label6_Click()
'Clear list
l1.Clear ' it holds video Ids
l2.Clear ' it Holds Title
'Get Next Search Page
intPagesCntr = intPagesCntr + 1
If intPagesCntr <= intPages Then
SearchEngine cmbQuery.Text, intPagesCntr, Inet1
Else
intPagesCntr = intPages
End If
End Sub
Private Sub Inet1_StateChanged(ByVal state As Integer)
'Displays Inet1 Status
lblFound.Caption = GetStatus(state, Inet1)
End Sub
Private Sub Label6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label6.BorderStyle = 1
End Sub
Private Sub Label6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label6.BorderStyle = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -