Could someone point me to any example code that could be used for automatic web updates for an EXE?
I would like to give my users an option to click "Update" and have the most recent version of the EXE downloaded and replace the current EXE.
Thanks!
Printable View
Could someone point me to any example code that could be used for automatic web updates for an EXE?
I would like to give my users an option to click "Update" and have the most recent version of the EXE downloaded and replace the current EXE.
Thanks!
Here's a template I made a while ago... it was for an app I made so the URL locations or the appname may stay in the prog, just change it... also you could drasticly improve the FileMove stuff (now with the API) but you can figure that out yourself
and put this code in a module:Code:'In the form, put a Internet Transfer Control (Inet1)
'a Label (lblStatus) and a ProgressBar (ProgressBar1)
Option Explicit
Dim Newver As String
Public Curver As String
Public cvfile As String
Dim fn As Long
Dim dl As String
Dim dlFile() As Byte
Dim dlPath As String
Private Sub Form_Activate()
On Error GoTo error:
Newver = Inet1.OpenURL("http://YOURSITE/newver.txt")
cvfile = App.Path & "\curver.txt"
fn = FreeFile
Open cvfile For Input As #fn
Line Input #fn, Curver
Close #fn
If Newver > Curver Then
dl = MsgBox("Update available! (" & Newver & " ) " & vbCrLf & "Do you want to download?", vbYesNo, "Update available!")
lblStatus = "Update available!"
ProgressBar1.Position = 0
If dl = vbYes Then
Call Download
End If
Else
MsgBox "No updates available!", , "Update available!"
lblStatus = "No updates available!"
Shell App.Path & "\YOURAPP.exe", vbNormalFocus
Unload Me
End If
error:
Call errorH
End Sub
Function Download()
On Error GoTo error
'Delete .bak file
If Dir(App.Path & "\YOURAPPNAME" & Curver & ".bak", vbNormal Or vbReadOnly Or vbHidden Or _
vbSystem Or vbArchive) <> "" Then
Kill App.Path & "\YOURAPPNAME" & Curver & ".bak"
End If
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
lblStatus.Caption = "YOURAPPNAMEr.exe > YOURAPPNAME.bak"
With fileop
.hwnd = 0
.wFunc = FO_RENAME
.pFrom = App.Path & "\YOURAPPNAMEOLD.exe" & vbNullChar & vbNullChar
.pTo = App.Path & "\YOURAPPNAMENEW" & Curver & ".bak" & vbNullChar & vbNullChar
.lpszProgressTitle = "Please wait, renaming APPNAME.exe to APPNAME.bak..."
.fFlags = FOF_SIMPLEPROGRESS Or FOF_ALLOWUNDO
End With
lret = SHFileOP(fileop)
'If Module1.result <> 0 Then 'Operation failed
'MsgBox Err.LastDllError 'Show the error returned from the API.
'Else
'If fileop.fAnyOperationsAborted <> 0 Then
'MsgBox "Operation Failed"
'End If
'End If
'Download the file
dlFile() = Inet1.OpenURL("http://YOURSITE/YOURAPPNAME.exe", icByteArray)
'Put it in the dir
fn = FreeFile
dlPath = App.Path & "\YOURAPPNAME.exe"
Open dlPath For Binary Access Write As #fn
Put #fn, , dlFile()
Close #fn
'Write New FileVersion to curver.txt
Open cvfile For Output As #fn
Print #fn, Newver
Close #fn
Dim msg As String
msg = "YOURAPPNAME succesfully updated!" & vbCrLf
msg = msg & "Your old APPNAME is renamed to " & App.Path & "\APPNAME" & Curver & ".bak"
ProgressBar1.Position = 0
MsgBox msg, , "Succesfully updated!"
'Run YOURAPPNAME.exe en Unload me!
Shell App.Path & "\YOURAPPNAME.exe", vbNormalFocus
Unload Me
error:
Call errorH
End Function
Private Sub Inet1_StateChanged(ByVal State As Integer)
Select Case State
Case icResolvingHost
ProgressBar1.Position = 1
lblStatus = "Connecting to server, please standby..."
Case icHostResolved
ProgressBar1.Position = 2
Case icConnecting
ProgressBar1.Position = 3
Case icConnected
ProgressBar1.Position = 4
Case icRequesting
lblStatus = "Checking for updates..."
ProgressBar1.Position = 5
Case icRequestSent
ProgressBar1.Position = 6
Case icReceivingResponse
ProgressBar1.Position = 7
Case icResponseReceived
ProgressBar1.Position = 8
lblStatus = "File version received..."
Case icError
ProgressBar1.Position = 0
lblStatus = "An error occurred"
MsgBox "There was an error proccessing the updater" & vbCrLf & Inet1.ResponseCode & vbCrLf & Inet1.ResponseCode
End Select
End Sub
Function errorH()
If Err.Number <> 0 Then
MsgBox "There was an error proccessing the updater" & vbCrLf & Err.Number & vbCrLf & Err.Description, , "Error!"
End If
End Function
If you need help ICQ me (18818940)Code:Option Explicit
Public Declare Function SHFileOperation Lib _
"shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As Any) As Long
Public Declare Sub SHFreeNameMappings Lib _
"shell32.dll" (ByVal hNameMappings As Long)
Public Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" (hpvDest As Any, hpvSource _
As Any, ByVal cbCopy As Long)
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As FO_Functions
pFrom As String
pTo As String
fFlags As FOF_Flags
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String 'only used if FOF_SIMPLEPROGRESS
End Type
Public Enum FO_Functions
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum
Public Enum FOF_Flags
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10
FOF_WANTMAPPINGHANDLE = &H20
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80
FOF_SIMPLEPROGRESS = &H100
FOF_NOCONFIRMMKDIR = &H200
FOF_NOERRORUI = &H400
FOF_NOCOPYSECURITYATTRIBS = &H800
FOF_NORECURSION = &H1000
FOF_NO_CONNECTED_ELEMENTS = &H2000
FOF_WANTNUKEWARNING = &H4000
End Enum
Public Type SHNAMEMAPPING
pszOldPath As String
pszNewPath As String
cchOldPath As Long
cchNewPath As Long
End Type
Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
'This uses a method suggested at MSKB to
'ensure that all parameters are passed correctly
'Call this wrapper rather than the API function directly
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte
lenFileop = LenB(lpFileOp)
ReDim foBuf(1 To lenFileop) 'the size of the structure.
'Now we need to copy the structure into a byte array
Call CopyMemory(foBuf(1), lpFileOp, lenFileop)
'Next we move the last 12 bytes by 2 to byte align the data
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))
SHFileOP = result
End Function