home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / YouTube_Do2112345102008.psc / frmDown.frm < prev    next >
Text File  |  2008-05-11  |  13KB  |  397 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  3. Begin VB.Form frmDown 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Download YouTube Video"
  6.    ClientHeight    =   4005
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   8370
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4005
  14.    ScaleWidth      =   8370
  15.    StartUpPosition =   2  'CenterScreen
  16.    Begin VB.CommandButton cmdClear 
  17.       Caption         =   "Clear"
  18.       BeginProperty Font 
  19.          Name            =   "Tahoma"
  20.          Size            =   8.25
  21.          Charset         =   0
  22.          Weight          =   400
  23.          Underline       =   0   'False
  24.          Italic          =   0   'False
  25.          Strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   300
  28.       Left            =   5805
  29.       TabIndex        =   8
  30.       Top             =   3645
  31.       Width           =   1140
  32.    End
  33.    Begin VB.CommandButton cmdDownload 
  34.       Caption         =   "Download"
  35.       BeginProperty Font 
  36.          Name            =   "Tahoma"
  37.          Size            =   8.25
  38.          Charset         =   0
  39.          Weight          =   400
  40.          Underline       =   0   'False
  41.          Italic          =   0   'False
  42.          Strikethrough   =   0   'False
  43.       EndProperty
  44.       Height          =   330
  45.       Left            =   4380
  46.       TabIndex        =   7
  47.       Top             =   4185
  48.       Visible         =   0   'False
  49.       Width           =   1215
  50.    End
  51.    Begin VB.CommandButton cmdCancel 
  52.       Caption         =   "Cancel"
  53.       BeginProperty Font 
  54.          Name            =   "Tahoma"
  55.          Size            =   8.25
  56.          Charset         =   0
  57.          Weight          =   400
  58.          Underline       =   0   'False
  59.          Italic          =   0   'False
  60.          Strikethrough   =   0   'False
  61.       EndProperty
  62.       Height          =   330
  63.       Left            =   7020
  64.       TabIndex        =   6
  65.       Top             =   3615
  66.       Width           =   1215
  67.    End
  68.    Begin MSComctlLib.ListView lstDownload 
  69.       Height          =   2640
  70.       Left            =   60
  71.       TabIndex        =   4
  72.       Top             =   585
  73.       Width           =   8220
  74.       _ExtentX        =   14499
  75.       _ExtentY        =   4657
  76.       View            =   3
  77.       LabelWrap       =   -1  'True
  78.       HideSelection   =   -1  'True
  79.       GridLines       =   -1  'True
  80.       _Version        =   393217
  81.       SmallIcons      =   "SmallImages"
  82.       ForeColor       =   -2147483640
  83.       BackColor       =   -2147483643
  84.       BorderStyle     =   1
  85.       Appearance      =   0
  86.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  87.          Name            =   "Tahoma"
  88.          Size            =   8.25
  89.          Charset         =   0
  90.          Weight          =   400
  91.          Underline       =   0   'False
  92.          Italic          =   0   'False
  93.          Strikethrough   =   0   'False
  94.       EndProperty
  95.       NumItems        =   3
  96.       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  97.          Text            =   "Video:"
  98.          Object.Width           =   9596
  99.       EndProperty
  100.       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  101.          Alignment       =   1
  102.          SubItemIndex    =   1
  103.          Text            =   "vID:"
  104.          Object.Width           =   2011
  105.       EndProperty
  106.       BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  107.          SubItemIndex    =   2
  108.          Text            =   "Status:"
  109.          Object.Width           =   2540
  110.       EndProperty
  111.    End
  112.    Begin Project1.DownYouTube DownYouTube 
  113.       Height          =   480
  114.       Left            =   1155
  115.       TabIndex        =   1
  116.       Top             =   2580
  117.       Width           =   480
  118.       _ExtentX        =   847
  119.       _ExtentY        =   847
  120.    End
  121.    Begin MSComctlLib.ProgressBar prgBAR 
  122.       Height          =   270
  123.       Left            =   1080
  124.       TabIndex        =   2
  125.       Top             =   4965
  126.       Width           =   6540
  127.       _ExtentX        =   11536
  128.       _ExtentY        =   476
  129.       _Version        =   393216
  130.       Appearance      =   0
  131.       Scrolling       =   1
  132.    End
  133.    Begin MSComctlLib.ImageList SmallImages 
  134.       Left            =   870
  135.       Top             =   4005
  136.       _ExtentX        =   1005
  137.       _ExtentY        =   1005
  138.       BackColor       =   -2147483643
  139.       ImageWidth      =   16
  140.       ImageHeight     =   16
  141.       MaskColor       =   12632256
  142.       _Version        =   393216
  143.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  144.          NumListImages   =   1
  145.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  146.             Picture         =   "frmDown.frx":0000
  147.             Key             =   ""
  148.          EndProperty
  149.       EndProperty
  150.    End
  151.    Begin VB.Label lblDTo 
  152.       BeginProperty Font 
  153.          Name            =   "Tahoma"
  154.          Size            =   8.25
  155.          Charset         =   0
  156.          Weight          =   400
  157.          Underline       =   0   'False
  158.          Italic          =   0   'False
  159.          Strikethrough   =   0   'False
  160.       EndProperty
  161.       Height          =   225
  162.       Left            =   1860
  163.       TabIndex        =   11
  164.       Top             =   3330
  165.       Width           =   6390
  166.    End
  167.    Begin VB.Label Label3 
  168.       Caption         =   "All Files Downloaded To:"
  169.       BeginProperty Font 
  170.          Name            =   "Tahoma"
  171.          Size            =   8.25
  172.          Charset         =   0
  173.          Weight          =   400
  174.          Underline       =   0   'False
  175.          Italic          =   0   'False
  176.          Strikethrough   =   0   'False
  177.       EndProperty
  178.       Height          =   285
  179.       Left            =   75
  180.       TabIndex        =   10
  181.       Top             =   3315
  182.       Width           =   1860
  183.    End
  184.    Begin VB.Label Label2 
  185.       BackStyle       =   0  'Transparent
  186.       Caption         =   "* Do Not Close This Window While Your File Is Downloading"
  187.       BeginProperty Font 
  188.          Name            =   "Tahoma"
  189.          Size            =   8.25
  190.          Charset         =   0
  191.          Weight          =   700
  192.          Underline       =   0   'False
  193.          Italic          =   0   'False
  194.          Strikethrough   =   0   'False
  195.       EndProperty
  196.       ForeColor       =   &H000000FF&
  197.       Height          =   315
  198.       Left            =   75
  199.       TabIndex        =   9
  200.       Top             =   3675
  201.       Width           =   5910
  202.    End
  203.    Begin VB.Label Label1 
  204.       BackStyle       =   0  'Transparent
  205.       Caption         =   "YouTube Video Download Que:"
  206.       BeginProperty Font 
  207.          Name            =   "Tahoma"
  208.          Size            =   9.75
  209.          Charset         =   0
  210.          Weight          =   700
  211.          Underline       =   0   'False
  212.          Italic          =   0   'False
  213.          Strikethrough   =   0   'False
  214.       EndProperty
  215.       ForeColor       =   &H00FFFFFF&
  216.       Height          =   300
  217.       Left            =   90
  218.       TabIndex        =   5
  219.       Top             =   135
  220.       Width           =   3240
  221.    End
  222.    Begin VB.Shape Shape1 
  223.       BackColor       =   &H00FF862D&
  224.       BackStyle       =   1  'Opaque
  225.       Height          =   540
  226.       Left            =   0
  227.       Top             =   0
  228.       Width           =   8370
  229.    End
  230.    Begin VB.Label lblLABEL 
  231.       Caption         =   " "
  232.       BeginProperty Font 
  233.          Name            =   "Tahoma"
  234.          Size            =   8.25
  235.          Charset         =   0
  236.          Weight          =   400
  237.          Underline       =   0   'False
  238.          Italic          =   0   'False
  239.          Strikethrough   =   0   'False
  240.       EndProperty
  241.       Height          =   255
  242.       Left            =   1095
  243.       TabIndex        =   3
  244.       Top             =   5310
  245.       Width           =   6465
  246.    End
  247.    Begin VB.Label lblTitle 
  248.       BeginProperty Font 
  249.          Name            =   "Tahoma"
  250.          Size            =   8.25
  251.          Charset         =   0
  252.          Weight          =   700
  253.          Underline       =   0   'False
  254.          Italic          =   0   'False
  255.          Strikethrough   =   0   'False
  256.       EndProperty
  257.       Height          =   270
  258.       Left            =   1125
  259.       TabIndex        =   0
  260.       Top             =   4605
  261.       Width           =   6510
  262.    End
  263. End
  264. Attribute VB_Name = "frmDown"
  265. Attribute VB_GlobalNameSpace = False
  266. Attribute VB_Creatable = False
  267. Attribute VB_PredeclaredId = True
  268. Attribute VB_Exposed = False
  269. Option Explicit
  270.  
  271. Private Sub cmdCancel_Click()
  272. DownYouTube.CancelAllDownload
  273. cmdClear_Click
  274. End Sub
  275.  
  276. Private Sub cmdClear_Click()
  277. On Error Resume Next
  278. lstDownload.ListItems.Remove (lstDownload.SelectedItem.Index)
  279. Call Form1.SaveList
  280. End Sub
  281.  
  282. Private Sub Form_Load()
  283. lblDTo.Caption = App.Path & "\Downloaded Files\"
  284.     Call LoadList
  285. End Sub
  286.  
  287. Public Function DownloadYT(URL$, FileName$)
  288. Dim Item As ListItem
  289. For Each Item In lstDownload.ListItems
  290.     DownYouTube.BeginDownload URL, App.Path & "\Downloaded Files\" & FileName & ".flv"
  291. Next
  292. End Function
  293.  
  294. Private Sub DownYouTube_DownloadAllComplete(FileNotDownload() As String)
  295.   Dim i As Integer
  296.     Debug.Print "Finished all download"
  297.     cmdDownload.Enabled = True
  298.     cmdCancel.Enabled = False
  299.     If UBound(FileNotDownload) > 0 Then
  300.         For i = 1 To UBound(FileNotDownload)
  301.             Debug.Print "File not downloaded: " & FileNotDownload(i)
  302.         Next i
  303.     End If
  304. End Sub
  305.  
  306. Private Sub DownYouTube_DownloadStage(sString As String)
  307. '
  308. End Sub
  309.  
  310. Private Sub DownYouTube_DownloadComplete(MaxBytes As Long, SaveFile As String)
  311.   Dim i As Integer
  312.     Debug.Print "Completed " & SaveFile & ", Size = " & MaxBytes
  313.     MsgBox "Completed!", vbInformation, "Success"
  314.     With lstDownload
  315.         For i = 1 To .ListItems.Count
  316.             If .ListItems(i).Key = SaveFile Then
  317.                 .ListItems(i).SubItems(2) = "Completed"
  318.             End If
  319.         Next i
  320.     End With
  321. cmdClear_Click
  322. Unload frmDown
  323. Call Form1.ClearConts
  324. Form1.Show
  325. End Sub
  326.  
  327. Private Sub DownYouTube_DownloadProgress(CurBytes As Long, MaxBytes As Long, SaveFile As String)
  328.   Dim i As Integer
  329.   Dim RemBytes As Long
  330.     With lstDownload
  331.         For i = 1 To .ListItems.Count
  332.                 RemBytes = MaxBytes - CurBytes
  333.                 If RemBytes < 2 ^ 20 Then
  334.                     .ListItems(i).SubItems(2) = Format((MaxBytes - CurBytes) / 2 ^ 10, "#0.0 KB") & _
  335.                                " (" & Format(CurBytes / MaxBytes, "#0.0%") & ")"
  336.                   Else
  337.                     .ListItems(i).SubItems(2) = Format((MaxBytes - CurBytes) / 2 ^ 20, "#0.00 MB") & _
  338.                                " (" & Format(CurBytes / MaxBytes, "#0.0%") & ")"
  339.             End If
  340.         Next i
  341.     End With
  342. End Sub
  343.  
  344. Private Sub DownYouTube_DownloadError(SaveFile As String)
  345.   Dim i As Integer
  346.     Debug.Print "Error downloading " & SaveFile
  347.     With lstDownload
  348.         For i = 1 To .ListItems.Count
  349.             If .ListItems(i).Key = SaveFile Then
  350.                 .ListItems(i).SubItems(2) = "Error"
  351.             End If
  352.         Next i
  353.     End With
  354. End Sub
  355.  
  356. Private Function GetFilename$(URL$)
  357.   Dim i As Integer
  358.     For i = Len(URL) To 1 Step -1
  359.         If Mid(URL, i, 1) = "/" Then
  360.             GetFilename = Right(URL, Len(URL) - i)
  361.             Exit For
  362.         End If
  363.     Next i
  364. End Function
  365.  
  366. Public Sub LoadList()
  367.     Dim fso As New FileSystemObject
  368.     Dim strm As TextStream
  369.     Dim Item As ListItem
  370.     Dim Tmp1 As String
  371.     Dim Tmp2 As String
  372.     Dim Tmp3 As String
  373.     
  374. On Error GoTo err
  375.     Set strm = fso.OpenTextFile(App.Path & "\List", ForReading)
  376. On Error Resume Next
  377.     lstDownload.ListItems.Clear
  378.     Do Until strm.AtEndOfStream
  379.         Tmp1 = strm.ReadLine
  380.         Tmp2 = strm.ReadLine
  381.         Tmp3 = strm.ReadLine
  382.         Set Item = lstDownload.ListItems.Add(, Tmp1, Tmp2)
  383.         Item.SubItems(1) = Tmp1
  384.         Item.SubItems(2) = Tmp3
  385.     Loop
  386.     strm.Close
  387.     Exit Sub
  388. err:
  389.     Set strm = fso.CreateTextFile(App.Path & "\List")
  390.     strm.Close
  391.     Dim File As File
  392.     Set File = fso.GetFile(App.Path & "\List")
  393.     File.Attributes = Hidden + System
  394.     LoadList
  395. End Sub
  396.  
  397.