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 / Form1.frm < prev    next >
Text File  |  2008-05-11  |  16KB  |  495 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  3. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.OCX"
  4. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
  5. Begin VB.Form Form1 
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "9InchWorM's YouTube Downloader"
  8.    ClientHeight    =   3765
  9.    ClientLeft      =   45
  10.    ClientTop       =   330
  11.    ClientWidth     =   8640
  12.    BeginProperty Font 
  13.       Name            =   "Tahoma"
  14.       Size            =   8.25
  15.       Charset         =   0
  16.       Weight          =   400
  17.       Underline       =   0   'False
  18.       Italic          =   0   'False
  19.       Strikethrough   =   0   'False
  20.    EndProperty
  21.    LinkTopic       =   "Form1"
  22.    MaxButton       =   0   'False
  23.    MinButton       =   0   'False
  24.    ScaleHeight     =   3765
  25.    ScaleWidth      =   8640
  26.    StartUpPosition =   2  'CenterScreen
  27.    Begin VB.CommandButton cmdDown 
  28.       Caption         =   "Download Video"
  29.       Enabled         =   0   'False
  30.       Height          =   285
  31.       Left            =   4200
  32.       TabIndex        =   22
  33.       Top             =   6435
  34.       Width           =   1860
  35.    End
  36.    Begin VB.CommandButton cmndViewQ 
  37.       Caption         =   "View Download Que"
  38.       Height          =   270
  39.       Left            =   4140
  40.       TabIndex        =   21
  41.       Top             =   6060
  42.       Visible         =   0   'False
  43.       Width           =   1890
  44.    End
  45.    Begin VB.Frame Frame1 
  46.       Caption         =   "Data: "
  47.       Height          =   2985
  48.       Left            =   135
  49.       TabIndex        =   7
  50.       Top             =   465
  51.       Width           =   8430
  52.       Begin VB.PictureBox Picture1 
  53.          Appearance      =   0  'Flat
  54.          BackColor       =   &H80000014&
  55.          ForeColor       =   &H80000008&
  56.          Height          =   2025
  57.          Left            =   5430
  58.          ScaleHeight     =   1995
  59.          ScaleWidth      =   2820
  60.          TabIndex        =   23
  61.          Top             =   495
  62.          Width           =   2850
  63.          Begin VB.Label Label6 
  64.             Alignment       =   2  'Center
  65.             Caption         =   "Preview Currently Unavailable"
  66.             BeginProperty Font 
  67.                Name            =   "Tahoma"
  68.                Size            =   9
  69.                Charset         =   0
  70.                Weight          =   400
  71.                Underline       =   0   'False
  72.                Italic          =   0   'False
  73.                Strikethrough   =   0   'False
  74.             EndProperty
  75.             Height          =   315
  76.             Left            =   120
  77.             TabIndex        =   24
  78.             Top             =   885
  79.             Width           =   2595
  80.          End
  81.       End
  82.       Begin VB.TextBox txtDes 
  83.          Appearance      =   0  'Flat
  84.          Enabled         =   0   'False
  85.          Height          =   900
  86.          Left            =   105
  87.          MultiLine       =   -1  'True
  88.          TabIndex        =   19
  89.          Top             =   1605
  90.          Width           =   4305
  91.       End
  92.       Begin VB.CommandButton cmdAddQ 
  93.          Caption         =   "Add To Download Que"
  94.          Height          =   270
  95.          Left            =   150
  96.          TabIndex        =   12
  97.          Top             =   2610
  98.          Width           =   1860
  99.       End
  100.       Begin VB.Label Label5 
  101.          Caption         =   "Description:"
  102.          Height          =   225
  103.          Left            =   90
  104.          TabIndex        =   20
  105.          Top             =   1365
  106.          Width           =   1755
  107.       End
  108.       Begin VB.Label lblCat 
  109.          Caption         =   "N/A"
  110.          BeginProperty Font 
  111.             Name            =   "Tahoma"
  112.             Size            =   8.25
  113.             Charset         =   0
  114.             Weight          =   700
  115.             Underline       =   0   'False
  116.             Italic          =   0   'False
  117.             Strikethrough   =   0   'False
  118.          EndProperty
  119.          Height          =   210
  120.          Left            =   885
  121.          TabIndex        =   18
  122.          Top             =   1155
  123.          Width           =   4830
  124.       End
  125.       Begin VB.Label Label4 
  126.          Caption         =   "Category:"
  127.          Height          =   240
  128.          Left            =   90
  129.          TabIndex        =   17
  130.          Top             =   1140
  131.          Width           =   1380
  132.       End
  133.       Begin VB.Label lblDate 
  134.          Caption         =   "N/A"
  135.          BeginProperty Font 
  136.             Name            =   "Tahoma"
  137.             Size            =   8.25
  138.             Charset         =   0
  139.             Weight          =   700
  140.             Underline       =   0   'False
  141.             Italic          =   0   'False
  142.             Strikethrough   =   0   'False
  143.          EndProperty
  144.          Height          =   225
  145.          Left            =   1080
  146.          TabIndex        =   16
  147.          Top             =   915
  148.          Width           =   2970
  149.       End
  150.       Begin VB.Label Label3 
  151.          Caption         =   "Date Added:"
  152.          Height          =   225
  153.          Left            =   90
  154.          TabIndex        =   15
  155.          Top             =   915
  156.          Width           =   1125
  157.       End
  158.       Begin VB.Label lblytUser 
  159.          Caption         =   "N/A"
  160.          BeginProperty Font 
  161.             Name            =   "Tahoma"
  162.             Size            =   8.25
  163.             Charset         =   0
  164.             Weight          =   700
  165.             Underline       =   0   'False
  166.             Italic          =   0   'False
  167.             Strikethrough   =   0   'False
  168.          EndProperty
  169.          Height          =   240
  170.          Left            =   1125
  171.          TabIndex        =   14
  172.          Top             =   675
  173.          Width           =   6405
  174.       End
  175.       Begin VB.Label Label1 
  176.          Caption         =   "Uploaded By:"
  177.          Height          =   285
  178.          Left            =   90
  179.          TabIndex        =   13
  180.          Top             =   675
  181.          Width           =   1260
  182.       End
  183.       Begin VB.Label lblTC 
  184.          Caption         =   "Title of Video To Download:"
  185.          Height          =   225
  186.          Left            =   75
  187.          TabIndex        =   11
  188.          Top             =   240
  189.          Width           =   2010
  190.       End
  191.       Begin VB.Label lblTitle 
  192.          Caption         =   "N/A"
  193.          BeginProperty Font 
  194.             Name            =   "Tahoma"
  195.             Size            =   8.25
  196.             Charset         =   0
  197.             Weight          =   700
  198.             Underline       =   0   'False
  199.             Italic          =   0   'False
  200.             Strikethrough   =   0   'False
  201.          EndProperty
  202.          Height          =   255
  203.          Left            =   2100
  204.          TabIndex        =   10
  205.          Top             =   240
  206.          Width           =   6045
  207.       End
  208.       Begin VB.Label Label2 
  209.          Caption         =   "Current Views:"
  210.          Height          =   240
  211.          Left            =   90
  212.          TabIndex        =   9
  213.          Top             =   450
  214.          Width           =   1125
  215.       End
  216.       Begin VB.Label lblViews 
  217.          Caption         =   "N/A"
  218.          BeginProperty Font 
  219.             Name            =   "Tahoma"
  220.             Size            =   8.25
  221.             Charset         =   0
  222.             Weight          =   700
  223.             Underline       =   0   'False
  224.             Italic          =   0   'False
  225.             Strikethrough   =   0   'False
  226.          EndProperty
  227.          Height          =   225
  228.          Left            =   1230
  229.          TabIndex        =   8
  230.          Top             =   450
  231.          Width           =   4725
  232.       End
  233.    End
  234.    Begin MSComDlg.CommonDialog cmd1 
  235.       Left            =   8160
  236.       Top             =   5160
  237.       _ExtentX        =   847
  238.       _ExtentY        =   847
  239.       _Version        =   393216
  240.    End
  241.    Begin VB.CommandButton Command2 
  242.       Caption         =   "Save"
  243.       BeginProperty Font 
  244.          Name            =   "MS Sans Serif"
  245.          Size            =   8.25
  246.          Charset         =   0
  247.          Weight          =   400
  248.          Underline       =   0   'False
  249.          Italic          =   0   'False
  250.          Strikethrough   =   0   'False
  251.       EndProperty
  252.       Height          =   330
  253.       Left            =   7410
  254.       TabIndex        =   6
  255.       Top             =   5760
  256.       Width           =   660
  257.    End
  258.    Begin RichTextLib.RichTextBox rtf1 
  259.       Height          =   915
  260.       Left            =   1170
  261.       TabIndex        =   5
  262.       Top             =   6420
  263.       Visible         =   0   'False
  264.       Width           =   1965
  265.       _ExtentX        =   3466
  266.       _ExtentY        =   1614
  267.       _Version        =   393217
  268.       Enabled         =   -1  'True
  269.       ScrollBars      =   3
  270.       TextRTF         =   $"Form1.frx":0000
  271.    End
  272.    Begin MSComctlLib.ProgressBar ProgressBar1 
  273.       Height          =   255
  274.       Left            =   -60
  275.       TabIndex        =   3
  276.       Top             =   5715
  277.       Visible         =   0   'False
  278.       Width           =   8640
  279.       _ExtentX        =   15240
  280.       _ExtentY        =   450
  281.       _Version        =   393216
  282.       BorderStyle     =   1
  283.       Appearance      =   0
  284.       Scrolling       =   1
  285.    End
  286.    Begin VB.TextBox txturl 
  287.       Appearance      =   0  'Flat
  288.       BackColor       =   &H00FFFFFF&
  289.       ForeColor       =   &H00404040&
  290.       Height          =   240
  291.       Left            =   1425
  292.       TabIndex        =   2
  293.       Text            =   "http://"
  294.       Top             =   120
  295.       Width           =   6240
  296.    End
  297.    Begin VB.PictureBox picstat1 
  298.       Align           =   2  'Align Bottom
  299.       Appearance      =   0  'Flat
  300.       BackColor       =   &H80000005&
  301.       BeginProperty Font 
  302.          Name            =   "Tahoma"
  303.          Size            =   8.25
  304.          Charset         =   0
  305.          Weight          =   700
  306.          Underline       =   0   'False
  307.          Italic          =   0   'False
  308.          Strikethrough   =   0   'False
  309.       EndProperty
  310.       ForeColor       =   &H80000008&
  311.       Height          =   270
  312.       Left            =   0
  313.       ScaleHeight     =   240
  314.       ScaleWidth      =   8610
  315.       TabIndex        =   1
  316.       Top             =   3495
  317.       Width           =   8640
  318.    End
  319.    Begin VB.CommandButton Command1 
  320.       Caption         =   "Get It"
  321.       Height          =   285
  322.       Left            =   7800
  323.       TabIndex        =   0
  324.       Top             =   90
  325.       Width           =   735
  326.    End
  327.    Begin VB.Label lblurl 
  328.       Caption         =   "YouTube URL:"
  329.       BeginProperty Font 
  330.          Name            =   "Tahoma"
  331.          Size            =   8.25
  332.          Charset         =   0
  333.          Weight          =   700
  334.          Underline       =   0   'False
  335.          Italic          =   0   'False
  336.          Strikethrough   =   0   'False
  337.       EndProperty
  338.       Height          =   300
  339.       Left            =   105
  340.       TabIndex        =   4
  341.       Top             =   165
  342.       Width           =   1575
  343.    End
  344. End
  345. Attribute VB_Name = "Form1"
  346. Attribute VB_GlobalNameSpace = False
  347. Attribute VB_Creatable = False
  348. Attribute VB_PredeclaredId = True
  349. Attribute VB_Exposed = False
  350. Option Explicit
  351.  
  352. Dim WithEvents wsc As DGSwsHTTP
  353. Attribute wsc.VB_VarHelpID = -1
  354. Dim yt As clsYouTubeParse
  355. Dim ytID$, ytUID$, ytCat$, ytDes$, sF$, Added$
  356.  
  357. Private Sub cmdAddQ_Click()
  358. If frmDown.lstDownload.ListItems.Count = 1 Then
  359. MsgBox "Sorry, multiple downloading is not implemented yet", vbInformation, "Sorry"
  360. Exit Sub
  361. Else
  362. sF = lblTitle & " - " & ytUID
  363. Call Add2DownQue(ytID, sF, lblTitle)
  364. Call ClearConts
  365. Added = lblTitle
  366. cmndViewQ_Click
  367. End If
  368. End Sub
  369.  
  370. Private Sub cmndViewQ_Click()
  371. Load frmDown
  372. frmDown.Show
  373. End Sub
  374.  
  375. Private Sub Form_Load()
  376. Set wsc = New DGSwsHTTP
  377. Set yt = New clsYouTubeParse
  378. End Sub
  379. Private Sub Command1_Click()
  380. If InStr(1, txturl, "http://www.youtube.com/watch?v=", vbTextCompare) Then
  381. stat1 "Downloading Data ..."
  382. wsc.geturl txturl
  383. Command1.Enabled = False
  384. Else
  385. MsgBox "Not a valid YouTube Address", vbCritical, "Error"
  386. End If
  387. End Sub
  388.  
  389. Private Sub wsc_DownloadComplete()
  390. Dim YTitle$
  391. stat1 "Data Recieved / YouTube VidID Recieved"
  392. rtf1.Text = wsc.filedata
  393. YTitle = yt.GetYouTubeVidTitle(wsc.filedata)
  394. lblTitle = YTitle 'Right(YTitle, Len(YTitle) - InStrRev(YTitle, "- "))
  395. ytID = "http://www.youtube.com/get_video.php?video_id=" & yt.GetYouTubeID(wsc.filedata)
  396. lblViews = yt.GetYouTubeViews(wsc.filedata)
  397. lblytUser = yt.GetYouTubeUserID(wsc.filedata)
  398. ytUID = yt.GetYouTubeUserID(wsc.filedata)
  399. ytCat = yt.GetYouTubeCategory(wsc.filedata)
  400. ytDes = yt.GetYouTubeDes(wsc.filedata)
  401. lblCat = Replace(ytCat, "&", "&&")
  402. lblDate = yt.GetYouTubeDate(wsc.filedata)
  403. txtDes = Replace(ytDes, "<span >", "")
  404. cmdDown.Enabled = True
  405. End Sub
  406.  
  407. Private Sub stat1(statusmsg As String)
  408. picstat1.Cls
  409. picstat1.Print statusmsg
  410. End Sub
  411.  
  412. Private Sub wsc_httpError(errmsg As String, Scode As String)
  413. stat1 ""
  414. ProgressBar1 = 0
  415. MsgBox errmsg & vbCrLf & wsc.ResponseHeaderString, vbExclamation, "Error"
  416. End Sub
  417.  
  418. Private Sub wsc_ProgressChanged(ByVal bytesreceived As Long)
  419. stat1 "Please Wait... Receiving YouTube Data ... " & bytesreceived & " Bytes Received Of: " & wsc.FileSize
  420. Dim percentcomplete As Long
  421. percentcomplete = 50
  422. If wsc.FileSize > 0 Then
  423.    percentcomplete = (bytesreceived / wsc.FileSize) * 100
  424. End If
  425. Me.ProgressBar1.Value = percentcomplete
  426. End Sub
  427.  
  428. Function Add2DownQue(URL$, SaveFile$, Description$)
  429. On Error GoTo err
  430. Dim Item As ListItem
  431. Dim Tmp1$
  432. Dim Tmp2$
  433. Dim Tmp3$
  434. Dim i As Integer
  435. Dim Success As Boolean
  436.     i = Len(URL) - 1
  437.         Success = False
  438.     Do Until i = 0
  439.         If Mid(URL, i, 1) = "/" Then
  440.             Tmp1 = Mid(URL, i + 1, Len(URL) - i)
  441.             Success = True
  442.             Exit Do
  443.         Else
  444.             i = i - 1
  445.         End If
  446.             Loop
  447.         If Success = False Then GoTo err
  448.             Tmp2 = Description
  449.             Tmp3 = "Pending..."
  450.         Set Item = frmDown.lstDownload.ListItems.Add(, Tmp1, Tmp2)
  451.             Item.SubItems(1) = Tmp1
  452.             Item.SubItems(2) = Tmp3
  453.             Command1.Enabled = True
  454.             MsgBox "Added to your Download Que", vbInformation, "Added"
  455.             Call SaveList
  456.             Call frmDown.DownloadYT(URL, SaveFile)
  457.         Exit Function
  458. err:
  459. Exit Function
  460. End Function
  461.  
  462. Public Sub SaveList()
  463.     Dim fso As New FileSystemObject
  464.     Dim strm As TextStream
  465.     Dim Item As ListItem
  466. On Error GoTo err
  467.     Set strm = fso.OpenTextFile(App.Path & "\List", ForWriting)
  468.     For Each Item In frmDown.lstDownload.ListItems
  469.     strm.WriteLine Item.Text
  470.     strm.WriteLine Item.SubItems(1)
  471.     strm.WriteLine Item.SubItems(2)
  472.     Next
  473.     strm.Close
  474.     Exit Sub
  475. err:
  476.     Set strm = fso.CreateTextFile(App.Path & "\List")
  477.     strm.Close
  478.     Dim File As File
  479.     Set File = fso.GetFile(App.Path & "\List")
  480.     File.Attributes = Hidden + System
  481.     Call SaveList
  482. End Sub
  483.  
  484. Public Function ClearConts()
  485. txturl = "http://"
  486. lblTitle = ""
  487. lblViews = ""
  488. lblytUser = ""
  489. lblDate = ""
  490. lblCat = ""
  491. txtDes = ""
  492. Command1.Enabled = True
  493. cmdDown.Enabled = False
  494. End Function
  495.