Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
'This code uses a menu item under HELP to call the CheckForUpdates routine. The routine verifies that
'a new version of the application is available from the server, downloads the new version file, and starts a
'second program called gbOnlineUpdate. The second program, gbOnlineUpdate, backs up the original EXE by
'renaming it as xxx.exe.old, then renames the download file as xxx.exe and optionally restarts the new program.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Include "CommCtrl.inc"
#Include "WinINET.inc"
%ID_Label = 400 : %ID_ProgressBar = 500
%ID_Button = 600
Global hDlg As Dword, hWait As Long
Function PBMain() As Long
Dialog New Pixels, 0, "File Download With Progress",300,300,300,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %ID_Button, "Get File", 10,10,75,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If Cb.Msg = %WM_Command And Cb.Ctl = %ID_Button Then GetFile
End Function
Sub GetFile
Local app$, LocalVer$, LocalFilePath$, URLSite$, URLVerPath$, URLFilePath$, Buffer$, ServerVer$
Local ServerFileSize&, AllBytes$, x As Long, y As Long, h As Long, w As Long, Style&, pid As Dword
Local LocalFilePathZ As Asciiz*%Max_Path, fName$
'local information
fName$ = "gbsnippets.zip"
LocalFilePath = EXE.Path$ + fName$ 'location to put file on local PC
LocalFilePathZ = LocalFilePath 'one of the API requires an AsciiZ version of the LocalFilePath
'server information
URLSite$ = "www.garybeene.com"
URLFilePath$ = "http://www.garybeene.com/files/gbsnippets.zip" 'get the new app from the server
'clear the cache for the .new file
DeleteURLCacheEntry(LocalFilePathZ) '1 = success clear the cache
'before downloading, remove existing version, if it exists
If IsFile(LocalFilePath$) Then Kill LocalFilePath$
'Get file size to use in download display status
Tcp Open "HTTP" At URLSite$ As #1 TimeOut 60000
Tcp Print #1, "HEAD " + URLFilePath$ + " HTTP/1.0"
Tcp Print #1, "" : Tcp Recv #1, 4096, Buffer$ : Tcp Close #1
Buffer$ = Remain$(Buffer$, "Content-Length:")
ServerFileSize& = Val(Extract$(Buffer$, $CrLf))
'Exit Sub if filesize is zero (tell user of the problem)
If ServerFileSize& = 0 Then
MsgBox "Download file Not found!", %MB_Ok + %MB_IconExclamation, "Online Update"
Exit Sub
End If
'Display a Downloading ... PleaseWait dialog with a download status progress bar
Dialog Get Client hDlg To w,h
Local locX As Long, locY As Long, sizeX As Long, sizeY As Long
sizeX = 170 : sizeY = 90
locX = (w-sizeX)/2 'gets left position of WaitDialog to center over app
locY = (h-sizeY)/2 'gets top position of WaitDialog to center over app
Dialog New Pixels, hDlg, "", locX, locY, sizeX, sizeY, %WS_Popup To hWait
Control Add Label, hWait, %ID_Label, $CrLf + "Downloading ... please wait !", 0, 0, sizeX, sizeY, %SS_Center Or %WS_Border
Control Set Color hWait, %ID_Label, %Black, %White
Control Add Progressbar, hWait, %ID_ProgressBar,"", 10,sizeY-40,sizeX-20,20 'bottom of dialog, but on top of label
Dialog Show Modeless hWait
'Download the file
Tcp Open "http" At URLSite$ As #1 TimeOut 60000 'connect
If Err Then Beep : Exit Sub
Tcp Print #1, "GET " & URLFilePath$ & " HTTP/1.0" 'send the GET request
Tcp Print #1, ""
Do 'get bytes until no more available
Tcp Recv #1, 4096, Buffer$
AllBytes$ = AllBytes$ + Buffer$
Progressbar Set Pos hWait, %ID_ProgressBar, (100*Len(AllBytes$)/ServerFileSize&)
Loop While IsTrue Len(Buffer$) And IsFalse Err
Tcp Close #1 'done, close the connection
Dialog End hWait 'Remove the download status dialog
If Len(AllBytes$) = 0 Then
'download failed. tell the user then exit sub
MsgBox "Download of updated version failed!", %MB_Ok Or %MB_IconInformation, "Online Update"
Exit Sub
End If
'Save the file, but first take off the HTTP header from the received bytes
AllBytes$ = Remain$(AllBytes$, $CrLf + $CrLf)
Open LocalFilePath$ For Binary As #1
Put$ #1,AllBytes$
Close #1
Dialog End hDlg 'quit this application - gbOnlineUpdate is now running
If IsFile(LocalFilePath$) Then
MsgBox "File now available locally!" + $CrLf + $CrLf + URLFilePath$, %MB_Ok+%MB_IconInformation,"Download File"
Else
MsgBox "File not found locally!" + $CrLf + $CrLf + URLFilePath$, %MB_Ok+%MB_IconExclamation,"Download File"
End If
End Sub
'gbs_00978
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm