[VB6] DownloadURL2File Function (Unicode-aware) + IsInternetConnected Function

[Bonnie West]

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
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, Optional ByVal dwFlagsAndAttributes As Long, Optional ByVal hTemplateFile As Long) As Long
Private Declare Function GetQueueStatus Lib "user32.dll" (ByVal Flags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInternet 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, ByRef lpdwNumberOfBytesRead As Long) As Long
Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, Optional ByRef lpNumberOfBytesWritten As Long, Optional ByVal lpOverlapped As Long) As Long

'Downloads the remote file specified by the sURL argument to the local file pointed
'by the sFileName parameter. The optional Chunk parameter determines the number
'of bytes to be downloaded at a time. Bigger chunks download faster while smaller
'ones enables the GUI to be more responsive. Returns the total number of bytes
'successfully written to disk. Maximum download size of 2,047.99 MB only.

Public Function DownloadURL2File(ByRef sURL As String, ByRef sFileName As String, Optional ByVal Chunk As Long = 1024&) As Long
    Const INTERNET_OPEN_TYPE_DIRECT = 1&, INTERNET_FLAG_DONT_CACHE = &H4000000, INTERNET_FLAG_RELOAD = &H80000000
    Const GENERIC_WRITE = &H40000000, FILE_SHARE_NONE = 0&, CREATE_ALWAYS = 2&, QS_ALLINPUT = &H4FF&
    Const INVALID_HANDLE_VALUE = -1&, ERROR_INSUFFICIENT_BUFFER = &H7A&
    Dim hInternet As Long, hURL As Long, hFile As Long, nBytesRead As Long, nBytesWritten As Long
    Dim bSuccess As Boolean, sBuffer_Ptr As Long, sBuffer_Size As Long, sBuffer As String

    Select Case True
        Case LenB(sURL) = 0&, LenB(sFileName) = 0&, Chunk < 2&:  Exit Function
    End Select

    hInternet = InternetOpenW(StrPtr(App.Title), INTERNET_OPEN_TYPE_DIRECT, 0&, 0&, 0&)
    If hInternet Then
        hURL = InternetOpenUrlW(hInternet, StrPtr(sURL), 0&, 0&, INTERNET_FLAG_DONT_CACHE Or INTERNET_FLAG_RELOAD, 0&)
        If hURL Then
            hFile = CreateFileW(StrPtr(sFileName), GENERIC_WRITE, FILE_SHARE_NONE, 0&, CREATE_ALWAYS) 'Overwrite existing
            If hFile <> INVALID_HANDLE_VALUE Then
                Do: SysReAllocStringLen VarPtr(sBuffer), , (sBuffer_Size + Chunk) * 0.5!
                    sBuffer_Size = LenB(sBuffer):   sBuffer_Ptr = StrPtr(sBuffer)
                    Do While InternetReadFile(hURL, sBuffer_Ptr, sBuffer_Size, nBytesRead)
                        If nBytesRead Then
                            bSuccess = (WriteFile(hFile, sBuffer_Ptr, nBytesRead, nBytesWritten) <> 0&) _
                                        And (nBytesWritten = nBytesRead): Debug.Assert bSuccess
                            If bSuccess Then DownloadURL2File = DownloadURL2File + nBytesWritten
                            If GetQueueStatus(QS_ALLINPUT) And &HFFFF0000 Then DoEvents
                        Else
                            Exit Do
                        End If
                    Loop
                Loop While Err.LastDllError = ERROR_INSUFFICIENT_BUFFER
                hFile = CloseHandle(hFile):                               Debug.Assert hFile
            End If
            hURL = InternetCloseHandle(hURL):                             Debug.Assert hURL
        End If
        hInternet = InternetCloseHandle(hInternet):                       Debug.Assert hInternet
    End If
End Function
 

Private Declare Function InternetCheckConnectionW Lib "wininet.dll" (Optional ByVal lpszUrl As Long, Optional ByVal dwFlags As Long, Optional ByVal dwReserved As Long) As Long

'Allows an application to check if a connection to the Internet can be established.
Public Function IsInternetConnected(Optional ByRef sURL As String = "http://www.google.com/") As Boolean
    Const FLAG_ICC_FORCE_CONNECTION = &H1&

    IsInternetConnected = InternetCheckConnectionW(StrPtr(sURL), FLAG_ICC_FORCE_CONNECTION)
End Function