[Webinar] Streamline your web hosting managementRegister Today

x
?
Solved

Binary File Download using InternetReadFile

Posted on 2004-09-01
11
Medium Priority
?
3,030 Views
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.

0
Comment
Question by:vbdev04
  • 6
  • 3
9 Comments
 
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
      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
 

Author Comment

by:vbdev04
ID: 11963251

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

0
 
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.
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 

Author Comment

by:vbdev04
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?

Thanks,
0
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 11967530
>>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
 
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)
0
 

Accepted Solution

by:
vbdev04 earned 0 total points
ID: 11992147

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
 
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.
0
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 11999652
Fine with me.
0

Featured Post

[Webinar] Improve your customer journey

A positive customer journey is important in attracting and retaining business. To improve this experience, you can use Google Maps APIs to increase checkout conversions, boost user engagement, and optimize order fulfillment. Learn how in this webinar presented by Dito.

Question has a verified solution.

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

Lotus Notes has been used since a very long time as an e-mail client and is very popular because of it's unmatched security. In this article we are going to learn about  RRV Bucket corruption and understand various methods to Fix "RRV Bucket Corrupt…
How much do you know about the future of data centers? If you're like 50% of organizations, then it's probably not enough. Read on to get up to speed on this emerging field.
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
With just a little bit of  SQL and VBA, many doors open to cool things like synchronize a list box to display data relevant to other information on a form.  If you have never written code or looked at an SQL statement before, no problem! ...  give i…
Suggested Courses

612 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