VB6 Downloading file with progress bar and KBP/S

Letsgetcoding
Letsgetcoding used Ask the Experts™
on
Hey guys,

Im needing to know how to download a file with a progress bar and showing the KBP/S.
The program will be the same every time and the URL will not change.

The code I have is below and it works fine. Just need to get the Progress bar and the KBP/S implemented.

Thanks,
Jessee
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function DownloadFromUrl(strFullUrl As String, _
            strSaveFile As String) As Boolean

Dim RetVal As Long
RetVal = URLDownloadToFile(0, strFullUrl, strSaveFile, 0, 0)

'Operation succeeded
If RetVal = 0 Then
    DownloadFromUrl = True
End If

End Function

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Here is an example of what you require.

A URLDownloadToFile Demo WITH PROGRESS bar/CANCEL
Top Expert 2010

Commented:
You might need to determine if your server returns the content-length header of the file in bytes, otherwise you won't know the size of the file to calculate the progress.
You can use the following code to check if it returns the size of the requested file

Option Explicit

Private Const WININET_API_FLAG_SYNC = &H4&
Private Const HTTP_QUERY_CONTENT_LENGTH = &H5&
Private Const HTTP_QUERY_FLAG_NUMBER = &H20000000

Private Declare Function InternetOpenW Lib "wininet" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrlW Lib "wininet" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInternet As Long) As Long
Private Declare Function HttpQueryInfoW Lib "wininet.dll" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpvBuffer As Long, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long

Public Function GetContentLength(ByVal url As String) As Long
    Dim hInternet       As Long
    Dim hRequest        As Long
    Dim dwFileSize      As Long
    Dim dwLength        As Long
    Dim dwIndex         As Long
    dwLength = 4 ' DWORD 32 bit value buffer length.
    hInternet = InternetOpenW(0, 1, 0, 0, WININET_API_FLAG_SYNC)
    hRequest = InternetOpenUrlW(hInternet, StrPtr(url), 0, 0, 0, 0)
    If HttpQueryInfoW(hRequest, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, _
        dwFileSize, dwLength, dwIndex) Then
        GetContentLength = dwFileSize
    Else
        GetContentLength = (-1)
    End If
    InternetCloseHandle hRequest
    InternetCloseHandle hInternet
End Function

Private Sub Form_Load()
    Debug.Print GetContentLength("http://www.google.com/intl/en_ALL/images/logos/images_logo_lg.gif")
End Sub

Open in new window

Author

Commented:
Hey,

It does return the correct size.

What next?

Thanks,
Jessee
Top Expert 2010
Commented:
In a module add the following... This will download the file and calculate progress.
Usage:
    DownloadFile "http://download.microsoft.com/download/5/6/7/567758a3-759e-473e-bf8f-52154438565a/dotnetfx.exe", "c:\users\username\documents\dotnetfx.exe"
     

Option Explicit
'egl1044
Private Const BUF_SIZE                      As Long = 4096  ' allocation buffer
Private Const INVALID_HANDLE_VALUE          As Long = (-1)
Private Const CREATE_ALWAYS                 As Long = &H2&
Private Const GENERIC_WRITE                 As Long = &H40000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG  As Long = 1
Private Const INTERNET_FLAG_NO_CACHE_WRITE  As Long = &H4000000
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000
Private Const INTERNET_FLAG_RESYNCHRONIZE   As Long = &H800&
Private Const HTTP_QUERY_CONTENT_LENGTH     As Long = &H5&
Private Const HTTP_QUERY_FLAG_NUMBER        As Long = &H20000000
Private Const WININET_API_FLAG_SYNC         As Long = &H4&

Private Declare Function CreateFileW Lib "Kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "Kernel32.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function InternetOpenW Lib "Wininet.dll" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrlW Lib "Wininet.dll" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "Wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Long
Private Declare Function InternetCloseHandle Lib "Wininet.dll" (ByVal hInternet As Long) As Long
Private Declare Function HttpQueryInfoW Lib "Wininet.dll" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpvBuffer As Long, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long

Private Function GetContentLength(ByVal url As String) As Long
    Dim hInternet       As Long
    Dim hRequest        As Long
    Dim dwFileSize      As Long
    Dim dwLength        As Long
    Dim dwIndex         As Long
    dwLength = 4 ' DWORD 32 bit value buffer length.
    hInternet = InternetOpenW(0, 1, 0, 0, WININET_API_FLAG_SYNC)
    hRequest = InternetOpenUrlW(hInternet, StrPtr(url), 0, 0, 0, 0)
    If HttpQueryInfoW(hRequest, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, _
        dwFileSize, dwLength, dwIndex) Then
        GetContentLength = dwFileSize
    Else
        GetContentLength = (-1)
    End If
    InternetCloseHandle hRequest
    InternetCloseHandle hInternet
End Function


Public Sub DownloadFile(ByVal url As String, ByVal filePath As String)
'egl1044
    Dim Buffer(BUF_SIZE)    As Byte
    Dim hInternet           As Long
    Dim hRequest            As Long
    Dim hFile               As Long 'file handle
    Dim dwBytesWritten      As Long 'bytes written
    Dim dwBytesRead         As Long 'bytes read
    Dim dwFileSize          As Long
    Dim dwStatus            As Long
    Dim dwPercent           As Long
    
    ' Returns requested size of the file on the server in bytes.
    dwFileSize = GetContentLength(url)
    
    If dwFileSize = (-1) Then
        Debug.Print "Content-Length couldn't be determined."
        Exit Sub
    End If
    
    ' Create the file, always overwriting any existing file
    hFile = CreateFileW(StrPtr("\\?\" & filePath), GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0)
    
    If hFile = INVALID_HANDLE_VALUE Then
      Debug.Print "CreateFile error"; Err.LastDllError
      Exit Sub ' _leave
    End If
    
    ' Initialize request
    hInternet = InternetOpenW(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, WININET_API_FLAG_SYNC)
    
    If hInternet = 0 Then
        CloseHandle hFile
        Debug.Print "InternetOpen error"; Err.LastDllError
        Exit Sub
    End If
    
    ' The requested url
    hRequest = InternetOpenUrlW(hInternet, StrPtr(url), 0, 0, _
        INTERNET_FLAG_NO_CACHE_WRITE Or _
        INTERNET_FLAG_RELOAD Or _
        INTERNET_FLAG_RESYNCHRONIZE, 0)

    
    If hRequest = 0 Then
        InternetCloseHandle hInternet
        CloseHandle hFile
        Debug.Print "InternetOpenUrl error"; Err.LastDllError
        Exit Sub
    End If
    ' Request the bytes and write them to the file.
    Do
      If InternetReadFile(hRequest, VarPtr(Buffer(0)), BUF_SIZE, dwBytesRead) Then
        If WriteFile(hFile, VarPtr(Buffer(0)), dwBytesRead, dwBytesWritten, 0) Then
            ' TODO:// calculate progress
            dwStatus = (dwStatus + dwBytesWritten)
            dwPercent = (dwStatus / dwFileSize) * 100
            Form1.Caption = dwPercent '<-- change this
        Else
            Debug.Print "WriteFile error"; Err.LastDllError
            Exit Do
        End If
      Else
        Debug.Print "InternetReadFile error"; Err.LastDllError
        Exit Do ' _leave
      End If
      DoEvents
    Loop Until dwBytesRead = 0
    
    ' cleanup
    InternetCloseHandle hRequest
    InternetCloseHandle hInternet
    CloseHandle hFile
    Erase Buffer
    Debug.Print "Done"
End Sub

Open in new window

Author

Commented:
Hey,

How do I change it to Progress bar format?
I tried:
frmDownload.PgbProgress.Max = dwFileSize
frmDownload.PgbProgress.Value = dwBytesWritten
Top Expert 2010

Commented:
The progress bar values should be in the range 0-100 as the example calculates the percentage.

frmDownload.PgbProgress.Value = dwPercent

Open in new window

Author

Commented:
Hey,

Sweet. Im now getting a CreateFile error 32?
Top Expert 2010

Commented:
The file handle is still opened usually happens when your debugging and the IDE throws an error and the CloseHandle() never had a chance to cleanup the handle. You have to close out the IDE or application then start fresh.

Author

Commented:
Hey,

So if I was running this as a .exe it wouldnt come up with this error?
Just restarted vb6 and it fixed it :)

Do you know of a way to find out the KBP/S?
Top Expert 2010

Commented:
What happens is that in the IDE if you would click the Stop or a Debugging error occured before the download completed the executing code would never have cleaned up the opened file handle. You can extend the example by adding a cancel flag that exits the loop if it's in progress so that the call to CloseHandle() will always cleanup the handle then you won't have to be concerned with this error, you also have to make sure that the location you download has write access permissions.
 

Author

Commented:
Ah I see what you mean now.

Are you able to help with the KBPS?
Top Expert 2010

Commented:
Calculate how many bytes have been read every second and divide by 1000. You then might need to take the overhead of time of the WriteFile() call to get the closest result.
Disable the timer and make the Interval 1000, just before the Loop begins enable the timer and then after loop disable the timer.
If your working with a small file I wouldn't even bother calculating the transfer rate , just show how many bytes have been completed of the file instead.

Author

Commented:
Thanks :)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial