Download URL w/Progress

Category: Internet

Date: 03-28-2012

Return to Index


 
'Compilable Example:
'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
#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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm