VB - Update program

[Narfy]

Any way to do it better?



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://
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.

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: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
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 (http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=22222&lngWId=1) or here (http://sourcesearch2.homestead.com/)).
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 ?