|
-
Jan 17th, 2013, 05:26 PM
#1
[VB6] DownloadURL2File Function (Unicode-aware) + IsInternetConnected Function
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 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
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
Last edited by Bonnie West; Mar 3rd, 2013 at 01:47 PM.
Reason: Short-circuited Or by using Select Case
On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)
-
Jul 2nd, 2023, 01:59 AM
#2
Hyperactive Member
Re: [VB6] DownloadURL2File Function (Unicode-aware) + IsInternetConnected Function
Last edited by Nouyana; Jul 2nd, 2023 at 02:40 AM.
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|