Binary File Download using InternetReadFile

Posted on 2004-09-01
Last Modified: 2008-03-10
How do I download binary file using InternetReadFile in Visual Basic 6?

Public Declare Function InternetReadFile Lib "wininet.dll" _
   (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
   lNumberOfBytesRead As Long) As Integer

As sBuffer is declared as String, it returns String.

Question by:vbdev04
  • 6
  • 3
LVL 75

Expert Comment

by:Anthony Perkins
ID: 11959818
This is a method in a class that I wrote some time back:

Private Sub GetLongFile(ByVal sSrcFilename As String, ByVal sDstFilename As String, ByVal lTransferType As Long, ByVal FileSize As Currency)
Const BufferLen = 2048
Dim hFtpFile As Long
Dim hLocalFile As Long
Dim Buffer As String
Dim BytesRead As Long
Dim BytesWritten As Long
Dim BytesTransferred As Currency
Dim CancelCopy As Boolean

CancelCopy = False

hFtpFile = FtpOpenFile(hConnect, sSrcFilename, GENERIC_READ, lTransferType Or INTERNET_FLAG_RELOAD, 0&)
If hFtpFile Then
   hLocalFile = CreateFile(sDstFilename, GENERIC_WRITE, 0&, 0&, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0&)
   If hLocalFile Then
      Buffer = Space$(BufferLen)
      BytesRead = 0
      BytesTransferred = 0
      CancelCopy = False
         If InternetReadFile(hFtpFile, Buffer, BufferLen, BytesRead) Then
            ' Due to a bug with the InternetReadFile API,
            ' we have to read the whole file before closing!
            ' Otherwise it appears to hang forever when hFtpFile is closed
            If Not CancelCopy Then
               If WriteFile(hLocalFile, Buffer, BytesRead, BytesWritten, 0&) Then
                  BytesTransferred = BytesTransferred + BytesWritten
                  RaiseEvent Progress(BytesTransferred, FileSize, CancelCopy)
                  Err.Raise Err.LastDllError
                  CancelCopy = True      'So the file gets deleted and exits the loop
               End If
            End If
            Err.Raise Err.LastDllError
            CancelCopy = True      'So the file gets deleted
         End If
      Loop While BytesRead > 0 'And Not CancelCopy
      CloseHandle hLocalFile
      If CancelCopy Then
         DeleteFile sDstFilename
      End If
       Err.Raise Err.LastDllError
   End If
   InternetCloseHandle hFtpFile
   hFtpFile = 0
   Err.Raise Err.LastDllError
End If

End Sub

Author Comment

ID: 11963251

Thanks but I want to use HTTP protocol instead of FTP.

LVL 75

Expert Comment

by:Anthony Perkins
ID: 11963675
I am sorry I overlooked that requirement in your question.  Hopefully someone else can step in.
Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.


Author Comment

ID: 11967303

Actually it is not your fault as I should have specified that in my question.

Does your function require anonymous FTP? also what are valid values for lTransferType?

LVL 75

Expert Comment

by:Anthony Perkins
ID: 11967530
>>Does your function require anonymous FTP?<<

>>also what are valid values for lTransferType?<<
Public Enum TransferTypesEnum
End Enum
LVL 75

Expert Comment

by:Anthony Perkins
ID: 11967585
I should have stated that hConnect is a private member of the class and it assumes it has already been initialized as in:
hInternet = InternetOpen(App.EXEName, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, INTERNET_FLAG_NO_CACHE_WRITE)
hConnect = InternetConnect(hInternet, sHost, mvarPort, sUsername, sPassword, INTERNET_SERVICE_FTP, dwFlags, &H0)

Just make sure you close them at the end, as in:
Call InternetCloseHandle(hConnect)
Call InternetCloseHandle(hInternet)

Accepted Solution

vbdev04 earned 0 total points
ID: 11992147

I got it to work using code from
It doesnt handle incorrect URL.

----- put this in module
Option Explicit

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
(ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, _
ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hfile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
ByRef lNumberOfBytesRead As Long) As Integer

Public Declare Function InternetReadBinaryFile Lib "wininet.dll" Alias "InternetReadFile" _
(ByVal hfile As Long, ByRef bytearray_firstelement As Byte, ByVal lNumBytesToRead As Long, _
ByRef lNumberOfBytesRead As Long) As Integer

Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer

Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hOpen As Long, ByVal infotype As Long, _
ByVal buffer As String, ByRef bufferlength As Long, ByVal Index As Long) As Long

Public Const NO_ERROR = 0             ' No error
Public Const INTERNET_FLAG_RELOAD = &H80000000

' Call function with URL and file name
Private Function getBinaryFile(url As String, fileName As String) As Boolean
    Dim hOpen As Long
    Dim hOpenUrl As Long
    Dim retval As Long
    Dim fileSize As Long
    Dim byteArray() As Byte
    Dim bufflen As Long
    Dim databuff As String * 8
    Dim bytesread As Long
    Dim intFile As Integer
    Dim isOpen As Boolean
    On Error GoTo errhandler
    bufflen = Len(databuff)
    hOpen = InternetOpen("myconn", INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0)
    hOpenUrl = InternetOpenUrl(hOpen, url, 0, 0, INTERNET_FLAG_RELOAD, 0)
    If hOpenUrl > 0 Then
        retval = HttpQueryInfo(hOpenUrl, 5, databuff, bufflen, 0)
        If retval > 0 Then
            fileSize = databuff
            ReDim byteArray(fileSize + 1) As Byte
            retval = InternetReadBinaryFile(hOpenUrl, byteArray(0), fileSize, bytesread)
            If (retval > 0) Then
                intFile = FreeFile
                Open fileName For Binary As #intFile
                isOpen = True
                Put #intFile, , byteArray
                Close #intFile
                isOpen = False
            End If
        End If
    End If
    getBinaryFile = True
    If Err.Number <> 0 Then
        getBinaryFile = False
    End If
    On Error Resume Next
    If hOpenUrl > 0 Then InternetCloseHandle (hOpenUrl)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)
    If isOpen Then Close #intFile
End Function

LVL 75

Expert Comment

by:Anthony Perkins
ID: 11993044
>>I got it to work using code from ...<<
Great, I am gald to hear it.  Please close this questiom.
LVL 75

Expert Comment

by:Anthony Perkins
ID: 11999652
Fine with me.

Featured Post

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Creating and Managing Databases with phpMyAdmin in cPanel.
Shadow IT is coming out of the shadows as more businesses are choosing cloud-based applications. It is now a multi-cloud world for most organizations. Simultaneously, most businesses have yet to consolidate with one cloud provider or define an offic…
Video by: Steve
Using examples as well as descriptions, step through each of the common simple join types, explaining differences in syntax, differences in expected outputs and showing how the queries run along with the actual outputs based upon a simple set of dem…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question