frmupdate.frm

hola, este es un programa chao

VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmUpdate 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   3525
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4665
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3525
   ScaleWidth      =   4665
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdDw 
      Appearance      =   0  'Flat
      Caption         =   "Download Update"
      Enabled         =   0   'False
      Height          =   255
      Left            =   1440
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   3120
      Width           =   1575
   End
   Begin ComctlLib.ProgressBar pb 
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   2520
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   450
      _Version        =   327682
      Appearance      =   0
   End
   Begin InetCtlsObjects.Inet Inet1 
      Left            =   6000
      Top             =   600
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin VB.CommandButton cmdCheck 
      Appearance      =   0  'Flat
      Caption         =   "Check for Update"
      Height          =   255
      Left            =   1560
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   1800
      Width           =   1575
   End
   Begin VB.Image Image2 
      Height          =   285
      Left            =   3960
      Picture         =   "frmUpdate.frx":0000
      Stretch         =   -1  'True
      Top             =   45
      Width           =   615
   End
   Begin VB.Image Image4 
      Height          =   375
      Left            =   0
      Picture         =   "frmUpdate.frx":247F
      Stretch         =   -1  'True
      Top             =   0
      Width           =   4695
   End
   Begin VB.Image clr 
      Height          =   240
      Left            =   8040
      Picture         =   "frmUpdate.frx":45CC
      Top             =   840
      Width           =   600
   End
   Begin VB.Image clb 
      Height          =   285
      Left            =   8040
      Picture         =   "frmUpdate.frx":6AF1
      Stretch         =   -1  'True
      Top             =   1200
      Width           =   615
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00C27C42&
      Height          =   5175
      Left            =   0
      Top             =   0
      Width           =   6615
   End
   Begin VB.Label lblSt 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   1320
      Width           =   4455
   End
   Begin VB.Label Label5 
      Caption         =   "Version Available:"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   840
      Width           =   1455
   End
   Begin VB.Label Label4 
      Caption         =   "Current Version:"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   480
      Width           =   1215
   End
   Begin VB.Label lblPercentage 
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   2760
      Width           =   1935
   End
   Begin VB.Label lblDownloading 
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   2160
      Width           =   4455
   End
   Begin VB.Label Label2 
      Height          =   375
      Left            =   2040
      TabIndex        =   3
      Top             =   840
      Width           =   2535
   End
   Begin VB.Label Label1 
      Height          =   255
      Left            =   2040
      TabIndex        =   2
      Top             =   480
      Width           =   2535
   End
End
Attribute VB_Name = "frmUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
Public intMyVer As Integer
Private Sub cmdCheck_Click()
Dim strSrch As String
Dim intNewVer As Variant
    'intNewVer = arr
    'strSrch = Inet1.OpenURL("http://gurukulwardha.co/ytvd/version.asp")
    strSrch = Inet1.OpenURL("http://localhost/version.asp")
    intNewVer = Split(strSrch, ".")
    Label2.Caption = intNewVer(0) & "." & intNewVer(1) & "." & intNewVer(3) ' Replace(strSrch, ".", "")
    
    intNewVer = intNewVer(0) & intNewVer(1) & intNewVer(3) 'Remove Extra Zero
    If intNewVer > intMyVer Then
        cmdDw.Enabled = True
        lblSt.Caption = "New version available"
        
    Else
        lblSt.Caption = "No New version available"
    End If
End Sub

Private Sub cmdDw_Click()
    'Downloader "http://gurukulwardha.co/ytvd/YoutubeVideoDownloader.exe", "ytvd", Inet1
    Downloader "http://localhost/YoutubeVideoDownloader.exe", "ytvd", Inet1
End Sub

Private Sub Form_Load()
    'Image4.Picture = Image4.Picture
    'Image2.Picture = frmMain.Image2.Picture
    
    Shape2.Width = Me.Width
    Shape2.Height = Me.Height
    
    intMyVer = App.Major & App.Minor & App.Revision
    Label1.Caption = App.Major & "." & App.Minor & "." & App.Revision
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Image2.Picture = clb.Picture
End Sub

Private Sub Image3_Click()
    Me.Hide
End Sub

Private Sub Image2_Click()
    Me.Hide
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 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)
    Image2.Picture = clb.Picture
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
    lblSt.Caption = GetStatus(state, Inet1)
End Sub
'1.3.0.16
Sub Downloader(Link As String, FileName As String, connection As Inet)
'On Error GoTo errr
    Dim FileSize As Long
    Dim sz As Double
    Dim FileRemaining As Long
    Dim FileNumber As Integer
    Dim FileData() As Byte
    Dim FileSize_Current As Long
    Dim PBValue As Integer
    
    Dim saVed As String
    Dim reMained As String
    
    'Send get request to Server for video file link
    connection.Execute Trim(Link), "GET"
    Do While connection.StillExecuting
        DoEvents
    Loop
        
    'fln = FileName 'stored for sharing name with other modules
    
    'Retrieve file size from content header
    'You can refer this Link for this:
    'http://support.microsoft.com/kb/163653
    FileSize = connection.GetHeader("Content-Length")
        sz = FileSize / 1000
        'lblSize.Caption = sz & " Kb"
    FileRemaining = FileSize
    FileSize_Current = 0
    
    pb.Max = FileSize
    
    
   


    FileNumber = FreeFile
    Open App.Path & "\" & FileName & ".yvd" For Binary Access Write As #FileNumber
    lblPercentage.Visible = True
    
    'This loop Download and Saves File to Disk
    'Simple one no need to give further comments
    
    Do Until FileRemaining = 0
        If FileRemaining > 1024 Then
            FileData = connection.GetChunk(1024, icByteArray)
            FileRemaining = FileRemaining - 1024
        Else
            FileData = connection.GetChunk(FileRemaining, icByteArray)
            FileRemaining = 0
        End If
      
        FileSize_Current = FileSize - FileRemaining
        PBValue = CInt((100 / FileSize) * FileSize_Current)
        saVed = FileSize_Current & " bits"
        reMained = FileSize - FileSize_Current & " bits"
        
        lblDownloading.Caption = "Downloading..(" & saVed & " out of " & FileSize & " bits )"
        lblPercentage.Caption = PBValue & " % Downloaded"
        'Image1.Width = PBValue * 40
        pb.Value = FileSize_Current
        Put #FileNumber, , FileData
    Loop
    
    Close #FileNumber
    
    MsgBox "File downloaded to Application Folder"

    Exit Sub
errr:
MsgBox "Error: " & vbCrLf & Err.Description & " Try Again..!" & vbCrLf

End Sub