# VBForums UtilityBank > UtilityBank - Components >  VB - Update program

## Narfy

Any way to do it better?


VB Code:
Private Function CheckForFile(FileName) As Boolean
'Check if file exists
CheckForFile = (Dir(FileName) <> "")
End Function
 Private Sub Patch()
On Error GoTo err
Dim intLocalVer As Integer
Dim b() As Byte
Dim intRemoteVer As Integer
Dim strRemoteVer As String
Dim doUpdate As Boolean
 '1. Open the local version file and read in the number
 Open App.Path & "\curversion.dat" For Input As #1
intLocalVer = CInt(Input(LOF(1), 1))
Close 1
 '2. Download the remote version file and read in the number
' Note: This is all one line:
Text1.Text = "Connecting..."
b() = InetUpdate.OpenURL("http://www.ofpnam.com/hammy/comref/remotever.dat", 1)
Text1.Text = "Connecting..." & vbNewLine & "Connected"
Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..."
strRemoteVer = ""
 For t = 0 To UBound(b)
strRemoteVer = strRemoteVer + Chr(b(t))
Next
 intRemoteVer = Int(strRemoteVer)
 '3. Compare numbers
 If intRemoteVer > intLocalVer Then
'Note: This is all one line:
    Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available"
    Text1.SelStart = Len(Text1.Text)
    upd = MsgBox("New version available, would you like to update it now? " & vbNewLine & "Please be patient, This may take a few minutes depending on connection speed.", vbYesNo Or vbQuestion)
    If upd = vbYes Then
        doUpdate = True
    End If
    If upd = vbNo Then
        doUpdate = False
        Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Canceled"
        Text1.SelStart = Len(Text1.Text)
        'Pause 2
    End If
Else
    'MsgBox "You have the most recent version of this program."
    Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "You have the most recent version!"
    Text1.SelStart = Len(Text1.Text)
    'Pause 2
    doUpdate = False
End If
 '4. If doupdate = True, then download the latest program exe from the site
 If doUpdate Then
'Note: This is all one line:
Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Downloading..."
Text1.SelStart = Len(Text1.Text)
 b() = InetUpdate.OpenURL("http://www.ofpnam.com/hammy/comref/1200.exe", 1)
Open App.Path & "\1200.exe" For Binary Access Write As #1
Put #1, , b()
Close 1
 b() = InetUpdate.OpenURL("http://www.ofpnam.com/hammy/comref/1200r.txt", 1)
            Open App.Path & "\1200r.txt" For Binary As #1
            Put #1, , b()
            Close #1
            
Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Downloading..." & vbNewLine & "Download Complete!" & vbNewLine & "Installing..."
            Text1.SelStart = Len(Text1.Text)
            'Name App.Path & "\ComRef.exe" As App.Path & "\OComRef.exe"
            Kill App.Path & "\ComRef.exe"
            'Kill App.Path & "\ComRef.exe"
            If CheckForFile(App.Path & "\Readme.doc") Then
                Kill App.Path & "\Readme.doc"
            Else
                Kill App.Path & "\Readme.txt"
            End If
            Name App.Path & "\1200r.txt" As App.Path & "\Readme.doc"
            Name App.Path & "\1200.exe" As App.Path & "\ComRef.exe"
            'Kill App.Path & "\OComRef.exe"
 'Now save the current version into the local version file
 Open App.Path & "\curversion.dat" For Output As #1
Print #1, strRemoteVer
Close 1
 Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Downloading..." & vbNewLine & "Download Complete!" & vbNewLine & "Installing..." & vbNewLine & "Installation Complete!" & vbNewLine & "Update was successful"
            Text1.SelStart = Len(Text1.Text)
 End If
err:
If err.Number = 13 Then
    MsgBox "Error connecting, please make sure you are connected to the internet.", vbCritical
    Text1.Text = "Connecting..." & vbNewLine & "Could not connect to server"
'Else
    'MsgBox err.Number & vbNewLine & err.Description
End If
 If err.Number = 53 Then
    MsgBox "Error finding files" & vbNewLine & "Please make sure the files: ComRef.exe, Update.exe, Readme.txt Or Readme.doc, and curversion.dat are in the same directory", vbCritical
End If
End Sub
 Public Sub Form_Unload(cancel As Integer)
On Error GoTo weeee:
    Shell App.Path & "\ComRef", vbNormalFocus
    GoTo end2
weeee:
    MsgBox "Could not find ComRef.exe, Update may have not been successful"
    GoTo end2
end2:
    Dim frm As Form
     For Each frm In Forms
         Unload frm
         Set frm = Nothing
     Next
 End Sub
 Private Sub Timer1_Timer()
Patch
Timer1.Enabled = False
End Sub

----------


## agmorgan

I have taken the code from About.com (which is what the above is based on I think) and made it into an ActiveX control.
It has a reference to Microsoft Scripting Runtime and uses the Microsoft Internet Transfer control.

*Usage* 
Select it from the list of components and put it on your form.
It is invisible at runtime.
Set the property RemoteEXE to the file you want to update to.
The path _must_ start with file:// or http:// 

VB Code:
ctlUpdate1.Update

*What it does* 
Uses GetModuleFileName to get the filename of the main exe
Uses FileSystemObject to get the version numbers of both files
Compares the versions.

On updating, 
The remote file is copied to the local directory
A batch file is created
TerminateProcess closes the main exe
The batch file deletes the main exe, 
The batch file renames the downloaded exe to the main exe name,
The batch file restarts the new exe
The batch file deletes itself.

*Thanks*
Thanks to crptcblade and Aaron Young for the API help
Thanks to anyone else who recognises their code that I might have copied.  :Thumb: 

I have pasted the code below, but also attached the project.


VB Code:
Option Explicit
'Default Property Values:
Const m_def_RemoteEXE = ""
'Property Variables:
Dim m_RemoteEXE As String
 Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, _
                                                                                      ByVal lpFileName As String, _
                                                                                      ByVal nSize As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
                                                                                    ByVal lpszShortPath As String, _
                                                                                    ByVal lBuffer As Long) As Long
 Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const PROCESS_TERMINATE As Long = (&H1)
   Private Function GetShortPath(strFileName As String) As String
    'KPD-Team 1999
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email]KPDTeam@Allapi.net[/email]
    Dim lngRes As Long, strPath As String
    'Create a buffer
    strPath = String$(165, 0)
    'retrieve the short pathname
    lngRes = GetShortPathName(strFileName, strPath, 164)
    'remove all unnecessary chr$(0)'s
    GetShortPath = Left$(strPath, lngRes)
End Function
 ' Return the path of a given full path to a file
'
Private Function returnPathOfFile(ByVal strFile As String) As String
    returnPathOfFile = Left(strFile, InStrRev(strFile, "\"))
End Function
 ' Return the filename of a given full path to a file
'
Private Function returnNameOfFile(ByVal strFile As String) As String
    returnNameOfFile = Mid(strFile, InStrRev(strFile, "\") + 1)
End Function
 Private Function Terminator()
    Dim objParent As Object
    Dim lngHwnd As Long
    Dim lngPID As Long
    
   
    ' Locate the Form on which the control is placed
    ' (not strictly necessary, but ensures a reliable Hwnd)
    Set objParent = UserControl.Extender.Parent
    While Not (TypeOf objParent Is Form)
        Set objParent = objParent.Parent
    Wend
    lngHwnd = objParent.hwnd
    
    ' No Hwnd, no Return value
    If lngHwnd = 0 Then
        Exit Function
    End If
    
    ' Get the owning Process ID
    Call GetWindowThreadProcessId(lngHwnd, lngPID)
    
    
    
    Dim Prog As Long
    Prog = OpenProcess(PROCESS_TERMINATE, lngHwnd, lngPID)
    If Prog Then
        TerminateProcess Prog, lngHwnd
        CloseHandle Prog
    Else
        MsgBox "You can't Kill This Process, Maybe because it's important for System"
    End If
End Function
     Private Sub UserControl_Initialize()
    cmdImage.Left = 0
    cmdImage.Top = 0
    UserControl.Width = cmdImage.Width
    UserControl.Height = cmdImage.Height
End Sub
 'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_RemoteEXE = m_def_RemoteEXE
End Sub
 'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_RemoteEXE = PropBag.ReadProperty("RemoteEXE", m_def_RemoteEXE)
End Sub
 Private Sub UserControl_Resize()
    UserControl.Width = cmdImage.Width
    UserControl.Height = cmdImage.Height
End Sub
 'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("RemoteEXE", m_RemoteEXE, m_def_RemoteEXE)
End Sub
 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0
Public Function Update() As Boolean
Dim b() As Byte
Dim strLocalNum() As String
Dim strRemoteNum() As String
Dim strLocalVer As String
Dim strRemoteVer As String
Dim blnUpdate As Boolean
 Dim fsoFile As File
Dim FSO As FileSystemObject
Dim strFileName As String
Dim strPath As String
Dim strFile As String
Dim i As Long
     'Get full path of parent exe (i.e. the local file)
    strFileName = Space$(255)
    Call GetModuleFileName(GetModuleHandle(vbNullString), strFileName, Len(strFileName))
    strFileName = Split(strFileName, vbNullChar)(0)
    strPath = returnPathOfFile(strFileName)
    strFile = returnNameOfFile(strFileName)
    
    'Get the version number of the local file
    Set FSO = New FileSystemObject
    Set fsoFile = FSO.GetFile(strFileName)
    strLocalVer = FSO.GetFileVersion(strFileName)
     'Get the version number of the remote file
    strFileName = Right(m_RemoteEXE, Len(m_RemoteEXE) - 7)
    Set FSO = New FileSystemObject
    Set fsoFile = FSO.GetFile(strFileName)
    strRemoteVer = FSO.GetFileVersion(strFileName)
      'Compare version numbers
    If strRemoteVer = strLocalVer Then
        blnUpdate = False
    Else
        strRemoteNum() = Split(strRemoteVer, ".")
        strLocalNum() = Split(strLocalVer, ".")
        'Compare major, then minor, then revision
        For i = 0 To UBound(strRemoteNum)
            If CInt(strRemoteNum(i)) > CInt(strLocalNum(i)) Then
                If MsgBox("A more recent version of this program exists. Would you like to update it now?", vbYesNo Or vbQuestion) = vbYes Then
                    blnUpdate = True
                Else
                    blnUpdate = False
                End If
                Exit For
            ElseIf CInt(strRemoteNum(i)) < CInt(strLocalNum(i)) Then
                blnUpdate = False
                Exit For
            Else
                'ie values are the same
                blnUpdate = False
                
            End If
        Next
    End If
     'If blnUpdate = True, then download the latest program exe from the remote site
    If blnUpdate Then
        'Copy the remote file into byte variable
         b() = InetUpdate.OpenURL(m_RemoteEXE, 1)
        'Write it as a temporary file
        Open strPath & "\update.exe" For Binary Access Write As #1
            Put #1, , b()
        Close 1
         'Write a batch file to delete running exe, rename updated exe, run updated exe
        'and delete the batch file itself
        strPath = GetShortPath(strPath) & "\test.bat"
        Open strPath For Output As #1
            Print #1, "@echo off"
            Print #1, ":start"
            Print #1, "cls"
            Print #1, "del " & strFile
            Print #1, "if  exist " & Chr$(34) & strFile & Chr$(34) & " goto start"
            Print #1, "ren update.exe " & strFile
            Print #1, strFile
            Print #1, "del test.bat"
        Close #1
        Shell strPath
        Terminator
    
    Else
        MsgBox "You already have the most recent version of this program."
    End If
 End Function
  'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get RemoteEXE() As String
    RemoteEXE = m_RemoteEXE
End Property
 Public Property Let RemoteEXE(ByVal New_RemoteEXE As String)
    m_RemoteEXE = New_RemoteEXE
    PropertyChanged "RemoteEXE"
End Property

----------


## si_the_geek

The code/files within this thread (submitted: 10-20-2004) have been checked for malware by a moderator.

Disclaimer: _This does not necessarily mean that any compiled files (DLL/EXE/OCX etc) are completely safe, but any supplied code does not contain any obvious malware.  It also does not imply that code is error free, or that it performs exactly as described.

It is recommended that you manually check any code before running it, and/or use an automated tool such as Source Search by Minnow (available here or here).  
If you find any serious issues (ie: the code causes damage or some sort), please contact a moderator of this forum.

Usage of any code/software posted on this forum is at your own risk._

----------


## Guerrero

there is some sample for this function in vb.net?

for example what is the best replacement for msinet.ocx .OpenURL ?

----------

