📄 frmmain.frm
字号:
BorderColor = &H00C27C42&
Height = 420
Left = 150
Top = 2205
Width = 4185
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "Remaining:"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 255
Index = 1
Left = 2760
TabIndex = 8
Top = 1680
Width = 1095
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "Saved:"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 255
Index = 0
Left = 4440
TabIndex = 7
Top = 2280
Width = 735
End
Begin VB.Label lblLeft
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 375
Left = 3960
TabIndex = 5
Top = 1680
Width = 2415
End
Begin VB.Label lblSaved
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 255
Left = 5160
TabIndex = 4
Top = 2280
Width = 2055
End
Begin VB.Label lblSize
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 255
Left = 1200
TabIndex = 3
ToolTipText = "Download File Size."
Top = 1680
Width = 2055
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "(Ex: http://youtube.com/watch?v=SSQEdNysJDA)"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 255
Left = 2160
TabIndex = 2
Top = 1155
Width = 4215
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Enter YouTube URL"
BeginProperty Font
Name = "Tahoma"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 255
Left = 240
TabIndex = 1
Top = 840
Width = 2295
End
Begin VB.Label HedLab
BackStyle = 0 'Transparent
Caption = "File size :"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 225
Index = 0
Left = 240
TabIndex = 0
Top = 1680
Width = 1035
End
Begin VB.Image Image4
Height = 375
Left = 0
Picture = "frmMain.frx":1692B
Stretch = -1 'True
Top = 0
Width = 6615
End
Begin VB.Image Image5
Height = 3255
Left = 0
Picture = "frmMain.frx":18A78
Stretch = -1 'True
Top = 240
Width = 6615
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'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
'Feedback @: http://notesonline.co.in/mail.asp
'Web: http://ytvd.notesonline.co.in
'
'Vote for Me
Option Explicit
'Show Folder--------------------------------------------------------
'This will be used to Play FLV file,
'provided a registered FLV player should be installed on ur System.
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_RESTORE = 9
'Show Folder--------------------------------------------------------
'This will be used to Play FLV file,
'provided a registered FLV player should be installed on ur System.
Dim flagExit As Boolean
Private Sub btnConv_Click()
frmConv.Top = Me.Top - frmConv.Height - 20
frmConv.Left = Me.Left
frmConv.Show 1
End Sub
Private Sub btnFolder_Click()
ShellExecute 0, vbNullString, App.Path, vbNullString, App.Path, SW_SHOWNORMAL
End Sub
Private Sub Image2_Click()
End
End Sub
Private Sub btnAbout_Click()
frmAbout.Show 1
End Sub
Private Sub btnAbout_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnAbout.BorderStyle = 1
End Sub
Private Sub btnAbout_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnAbout.BorderStyle = 0
End Sub
Private Sub btnCancel_Click()
sbrStatus.Panels(1).Text = "Waiting For Command"
frmMain.Tag = "Cancel"
btnDownload.Enabled = True
btnDownload.BorderStyle = 0
pannelRelax.Visible = False
End Sub
Private Sub btnCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnCancel.BorderStyle = 1
End Sub
Private Sub btnCancel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnCancel.BorderStyle = 0
End Sub
Private Sub btnDownload_Click()
Dim strF As String
'Download button....
imgPlay.Visible = False
frmMain.btnFolder.Visible = False
btnDownload.Enabled = False
btnDownload.BorderStyle = 1
pannelRelax.Visible = True
'Tag clear
frmMain.Tag = ""
Image1.Width = 0
Image1.Visible = True
'Check empty URL
If Text1.Text = "" Or Text1.Text = Empty Then
sbrStatus.Panels(1).Text = "See Help Menu or Please Enter YouTube Video Url..!"
btnDownload.Enabled = True
btnDownload.BorderStyle = 0
dbug "No input"
pannelRelax.Visible = False
Exit Sub
End If
'First get the Video file name and direct download link
'Download video
'DownloadFlv "http://localhost/YoutubeVideoDownloader.exe", "test"
DownloadFlv GetVideoFile(Text1.Text, Inet1), vName & ".flv"
End Sub
Private Sub btnDownload_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnDownload.BorderStyle = 1
End Sub
Private Sub btnDownload_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnDownload.BorderStyle = 0
End Sub
Private Sub btnExit_Click()
End
End Sub
Private Sub btnSearch_Click()
frmSearch.Show 1
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 Form_Load()
On Error GoTo NoRuntime
If GetSetting(App.EXEName, "Settings", "Profile") = "" Then
frmReg.Show 1
Else
eml = GetSetting(App.EXEName, "Settings", "Name")
uName = GetSetting(App.EXEName, "Settings", "Email")
Dbuglog = GetSetting(App.EXEName, "Settings", "Query")
'Debug.Print eml & " " & uName
Timer1.Enabled = True
End If
Me.Caption = App.Title & " Version " & App.Major & "." & App.Minor & "." & App.Revision & " By Rajendra Khope"
sbrStatus.Panels(1).Text = "Status: Welcome"
Image1.Visible = False
frmMain.Tag = ""
Image1.Width = 0
Timer1.Enabled = True
Exit Sub
NoRuntime:
MsgBox "Visual Basic 6.0 Runtime is neccessary to run this program properly." & vbCrLf & "Please install it and then run this programe." & vbCrLf & vbCrLf & "Error: " & Err.Description, vbCritical, "Run time Error!"
End Sub
Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image2.Picture = clr.Picture
End Sub
Private Sub Image3_Click()
MsgBox txtHlp.Text
End Sub
Private Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
formdrag Me
'################ Little Piece of Code Work Like winamp windows ####################
frmdbug.Left = (Me.Left + Me.Width) + 20 '###### :) ##########
frmdbug.Top = Me.Top '####################
'################ Little Piece of Code Work Like winamp windows ####################
End Sub
Private Sub Image4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image2.Picture = clb.Picture
End Sub
Private Sub Image5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image2.Picture = clb.Picture
End Sub
Private Sub imgPlay_Click()
ShellExecute 0, vbNullString, App.Path & "\" & fln & ".flv", vbNullString, vbNullString, vbNormalFocus
End Sub
Private Sub imgPlay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgPlay.BorderStyle = 1
End Sub
Private Sub imgPlay_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgPlay.BorderStyle = 0
End Sub
Private Sub Inet2_StateChanged(ByVal state As Integer)
sbrStatus.Panels(1).Text = GetStatus(state, Inet2)
End Sub
Private Sub Label4_Click()
frmdbug.Left = (Me.Left + Me.Width) + 20
frmdbug.Top = Me.Top
frmdbug.Show
End Sub
Private Sub Label5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
formdrag Me
'################ Little Piece of Code Work Like winamp windows ####################
frmdbug.Left = (Me.Left + Me.Width) + 20 '###### :) ##########
frmdbug.Top = Me.Top '####################
'################ Little Piece of Code Work Like winamp windows ####################
End Sub
Private Sub lblUpdate_Click()
Dim intMyVer As String
intMyVer = App.Major & "." & App.Minor & "." & App.Revision
If (Dir(App.Path & "\YTVD_temp.res") = "YTVD_temp.res") Then
'Name App.Path & "\YTVD_temp.res" As App.Path & "\Update.exe"
FileCopy App.Path & "\YTVD_temp.res", App.Path & "\Update.exe"
Else
Image1.Width = 0
Image1.Visible = True
DownloadFlv "http://www.figmentsol.com/ytvd/YTVD_temp.zip", "YTVD_temp.res"
MsgBox "Updater downloade.."
FileCopy App.Path & "\YTVD_temp.res", App.Path & "\Update.exe"
End If
Dim ans As Integer
ans = MsgBox("This will Close YoutubeVideoDownloader and launch Updater." & vbCrLf & "Do you wish to continue?", vbYesNo, "YTVD Updater")
If ans = 6 Then
ShellExecute 0, vbNullString, App.Path & "\Update.exe", intMyVer, App.Path, SW_SHOWNORMAL
' ShellExecute
End
Else
MsgBox "Ok try Latter!!!", vbInformation
End If
End Sub
Private Sub Timer1_Timer()
'IsNet checkNet 'Will be Used Latter for Future Enhancement
If (Dir(App.Path & "\YTVD_temp.res") = "YTVD_temp.res") Then
'Name App.Path & "\YTVD_temp.res" As App.Path & "\Update.exe"
FileCopy App.Path & "\YTVD_temp.res", App.Path & "\Update.exe"
Else
MsgBox "Update utility not found!" & vbCrLf & "You will not be able to update your application", vbCritical, "Warning!"
End If
Timer1.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -