[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2965
  • Last Modified:

Binary File Download using InternetReadFile

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.

0
vbdev04
Asked:
vbdev04
  • 6
  • 3
1 Solution
 
Anthony PerkinsCommented:
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
      Do
         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)
               Else
                  Err.Raise Err.LastDllError
                  CancelCopy = True      'So the file gets deleted and exits the loop
               End If
            End If
         Else
            Err.Raise Err.LastDllError
            CancelCopy = True      'So the file gets deleted
         End If
         DoEvents
      Loop While BytesRead > 0 'And Not CancelCopy
      CloseHandle hLocalFile
      If CancelCopy Then
         DeleteFile sDstFilename
      End If
   Else
       Err.Raise Err.LastDllError
   End If
   InternetCloseHandle hFtpFile
   hFtpFile = 0
Else
   Err.Raise Err.LastDllError
End If

End Sub
0
 
vbdev04Author Commented:

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

0
 
Anthony PerkinsCommented:
I am sorry I overlooked that requirement in your question.  Hopefully someone else can step in.
0
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 
vbdev04Author Commented:

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?

Thanks,
0
 
Anthony PerkinsCommented:
>>Does your function require anonymous FTP?<<
Nope.

>>also what are valid values for lTransferType?<<
Public Enum TransferTypesEnum
   ASCII = FTP_TRANSFER_TYPE_ASCII
   Binary = FTP_TRANSFER_TYPE_BINARY
End Enum
0
 
Anthony PerkinsCommented:
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)
0
 
vbdev04Author Commented:

I got it to work using code from http://www.catenary.com/howto/tiff_inet.html.
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
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0

' 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
   
errhandler:
    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

0
 
Anthony PerkinsCommented:
>>I got it to work using code from ...<<
Great, I am gald to hear it.  Please close this questiom.
0
 
Anthony PerkinsCommented:
Fine with me.
0

Featured Post

Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now