Update Now! Control makes an easy way to add an Online Update feature for your software.

Category:

Network/Internet

Type:

Controls

Difficulty:

Intermediate

Author: lonsoft

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

Update Now! Control makes an easy way to add an Online Update feature for your software. It was designed to be as http://www.lanssoft.com/updatenow.htm http://www.lanssoft.com/download/updatenow.exe programmer-friendly as possible, by providing features such as no user input to run in the background and event-driven notifications ... Feature highlights: Download now! is completely API compilation, you won't need additional attachment Microsoft WinSock Control; Supporting proxy server and its checking function; Supporting Resume broken downloads; Perfect status events, Is so convenient for you to write out more friendly interface; Supplying beautiful download progress bar; Download now! it is Asynchronous operation, namely you don't need to wait for the completion of the download threads, you can deal with other tasks at the same time, The control will process the download job at the background automatically without any intervention of the user.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
http://www.lanssoft.com/updatenow.htm http://www.lanssoft.com/download/updatenow.exe Feature highlights: Download now! is completely API compilation, you won't need additional attachment Microsoft WinSock Control; Supporting proxy server and its checking function; Supporting Resume broken downloads; Perfect status events, Is so convenient for you to write out more friendly interface; Supplying beautiful download progress bar; Download now! it is Asynchronous operation, namely you don't need to wait for the completion of the download threads, you can deal with other tasks at the same time, The control will process the download job at the background automatically without any intervention of the user.

Code:

VERSION 5.00
Object = "{1B7F7B82-0C56-4995-BB28-1CD47897902D}#24.0#0"; "UpdateNow.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Online Update"
   ClientHeight    =   3285
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6675
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3285
   ScaleWidth      =   6675
   StartUpPosition =   2  'ÆÁÄ»ÖÐÐÄ
   Tag             =   "7777777"
   Begin UpdateNow.DownloadFile DownloadFile1 
      Height          =   300
      Left            =   2370
      Tag             =   "666666666"
      Top             =   1830
      Width           =   3600
      _ExtentX        =   6350
      _ExtentY        =   529
      WhileFileExist  =   1
      ProgressColor   =   -2147483624
      HTTPVersion     =   1
   End
   Begin VB.Timer tmrImage 
      Enabled         =   0   'False
      Interval        =   250
      Left            =   2040
      Top             =   2775
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3645
      TabIndex        =   3
      Top             =   2805
      Width           =   1320
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Start"
      Default         =   -1  'True
      Height          =   375
      Left            =   5100
      TabIndex        =   2
      Top             =   2805
      Width           =   1320
   End
   Begin VB.Frame Frame1 
      Caption         =   "Online Update:"
      Height          =   2490
      Left            =   1920
      TabIndex        =   1
      Top             =   180
      Width           =   4530
      Begin VB.PictureBox picJinDu 
         BackColor       =   &H80000008&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   3030
         Picture         =   "frmMain.frx":0CCA
         ScaleHeight     =   210
         ScaleWidth      =   315
         TabIndex        =   4
         Top             =   645
         Visible         =   0   'False
         Width           =   315
      End
      Begin VB.Label Label2 
         Caption         =   "Downloading update package:"
         Height          =   225
         Left            =   270
         TabIndex        =   6
         Top             =   1215
         Width           =   2760
      End
      Begin VB.Label Label1 
         Caption         =   "Checking for new version:"
         Height          =   225
         Left            =   270
         TabIndex        =   5
         Top             =   645
         Width           =   2325
      End
      Begin VB.Image Image1 
         Height          =   210
         Index           =   1
         Left            =   1605
         Picture         =   "frmMain.frx":108C
         Top             =   1995
         Visible         =   0   'False
         Width           =   315
      End
      Begin VB.Image Image1 
         Height          =   210
         Index           =   2
         Left            =   525
         Picture         =   "frmMain.frx":144E
         Top             =   1965
         Visible         =   0   'False
         Width           =   315
      End
      Begin VB.Image Image1 
         Height          =   210
         Index           =   0
         Left            =   2070
         Picture         =   "frmMain.frx":1810
         Top             =   2010
         Visible         =   0   'False
         Width           =   315
      End
   End
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      Height          =   3330
      Left            =   15
      Picture         =   "frmMain.frx":1BD2
      ScaleHeight     =   3330
      ScaleWidth      =   1800
      TabIndex        =   0
      Top             =   -15
      Width           =   1800
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Upload the "version.ini" file to your own host
'
'The URL for checking new version
Private Const VersionURL = "http://lanssoft.com/update/version.ini"

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
Const SW_SHOWNORMAL = 1

Private cINI As clsINI

Private strOldVer As String
Private sNewVersion As String
Private sDescription As String
Private sURL As String

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub Command1_Click()
    strOldVer = cINI.ReadIni("Main", "LastVersion", cINI.INIFile)
    If strOldVer = "" Then strOldVer = "1.0"
    
    On Error Resume Next
    If DownloadFile1.Tag = "" Then
        tmrImage.Enabled = False
        Command1.Caption = "Update"
        DownloadFile1.Tag = "dddddd"
        picJinDu.Visible = False
        DownloadFile1.CancelDownload
    Else
        Command1.Caption = "Abort"
        tmrImage.Enabled = True
        picJinDu.Visible = True
        With DownloadFile1
            .Tag = "info"
            .RegName = ""
            .RegID = ""
            .LocalFileName = getAppPath & "version.ini"
            .Server = VersionURL
            .URL = VersionURL
            .HTTPVersion = [HTTP 1.1]
            .WhileFileExist = lOverWrite
            Debug.Print .GetHttpHead
            .StartDownload
        End With
    End If
End Sub

Private Sub DownloadFile1_OnError(ByVal Number As Integer, Description As String)
    Debug.Print DownloadFile1.ReceiveHead
    If InStr(Description, "404") Then
        MsgBox "Online update unsuccessfully, Please try again latter...", vbCritical
    Else
        MsgBox "Online update unsuccessfully, maybe the problem is :" & vbCrLf & Description, vbCritical
    End If
    DownloadFile1.Tag = ""
    Command1_Click
End Sub

Private Sub DownloadFile1_OnFinish()
    Select Case DownloadFile1.Tag
        Case "info"
            UpdateNewVersion
        Case "update"
             cINI.WriteIni "Main", "LastVersion", sNewVersion, cINI.INIFile
             ShellExecute Me.hwnd, "", getAppPath & "update.exe", "", App.Path, SW_SHOWNORMAL
             cmdCancel_Click
             End
    End Select
End Sub
Private Sub UpdateNewVersion()
        sNewVersion = cINI.ReadIni("update", "Version", getAppPath & "version.ini")
        sDescription = cINI.ReadIni("update", "Description", getAppPath & "version.ini")
        sURL = Trim(cINI.ReadIni("update", "URL", getAppPath & "version.ini"))
        sURL = Replace(sURL, Chr(0), "")
        sURL = Replace(sURL, vbCrLf, "")
        
        DownloadFile1.Tag = ""
        If sNewVersion <= strOldVer Or sURL = "" Then
            MsgBox "There are no new version on server!", vbInformation
            Command1_Click
            cmdCancel_Click
            Exit Sub
        End If
        
        With DownloadFile1
            .Tag = "update"
            .LocalFileName = getAppPath & "update.exe"
            .URL = sURL
            .Server = sURL
            Debug.Print .GetHttpHead
        End With
        
        If MsgBox("The new version is " & sNewVersion & ",On this version:" & vbCrLf & sDescription & vbCrLf & vbCrLf & "Do you make sure to update to the new version?", vbQuestion + vbYesNo) = vbNo Then
            DownloadFile1.Tag = ""
            Command1_Click
            Exit Sub
        End If
        picJinDu.Top = 1200
        
         'Starting update
        DownloadFile1.StartDownload
        
        '------------------------------------------------------------------
        '>> If the updater runs a second time,
        '>> it doesn¡¯t reupdate the software.
        '
        ' To resovle this problem. And this bug will be fixed in the new version
        '------------------------------------------------------------------
        Do While DownloadFile1.IsBusy
            DoEvents
        Loop
End Sub

Private Sub Form_Load()
    Set cINI = New clsINI
    cINI.INIFile = getAppPath & "config.ini"
End Sub

Private Sub tmrImage_Timer()
    tmrImage.Tag = Val(tmrImage.Tag) + 1
    If tmrImage.Tag > 2 Then tmrImage.Tag = 0
    picJinDu.Picture = Image1(Val(tmrImage.Tag)).Picture
End Sub

Private Function getAppPath()
    getAppPath = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
End Function