Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1461

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

$
0
0
Code:


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
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 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 2047.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&
    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

    If
LenB(sURL) = 0& Or LenB(sFileName) = 0& Or Chunk < 2& Then Exit Function

    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
                            DoEvents
                            If bSuccess Then DownloadURL2File = DownloadURL2File + nBytesWritten
                        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


Code:


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


Viewing all articles
Browse latest Browse all 1461

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>