+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Expanding Horizons (Libraries) (https://staging.qb64phoenix.com/forumdisplay.php?fid=21)
+---- Forum: Spriggsy (https://staging.qb64phoenix.com/forumdisplay.php?fid=30)
+---- Thread: URL Downloader (/showthread.php?tid=899)
URL Downloader - SpriggsySpriggs - 09-17-2022
This code launches a console window, asks for a link and a name for the file. Then it downloads and shows the progress as it goes. Works with HTTP and HTTPS using Win32 API. Enjoy.
P.S. The console window is so you can easily paste the URL
Code: (Select All)
Option _Explicit
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_DEFAULT_HTTP_PORT = 80
Const INTERNET_DEFAULT_HTTPS_PORT = 443
Const INTERNET_SERVICE_HTTP = 3
'Flags
Const INTERNET_FLAG_SECURE = &H00800000
Const INTERNET_FLAG_RELOAD = &H80000000
Const HTTP_QUERY_CONTENT_LENGTH = 5
Const TRUE = 1
'CONST FALSE = 0
Const KILOBYTE = 1024
Const MEGABYTE = KILOBYTE ^ 2
Const GIGABYTE = KILOBYTE ^ 3
Const TERABYTE = KILOBYTE ^ 4
Declare Dynamic Library "Wininet"
Function InternetOpen%& Alias "InternetOpenA" (ByVal lpszAgent As _Offset, Byval dwAccessType As Long, Byval lpszProxy As _Offset, Byval lpszProxyBypass As _Offset, Byval dwFlags As Long)
Function InternetConnect%& Alias "InternetConnectA" (ByVal hInternet As _Offset, Byval lpszServerName As _Offset, Byval nServerPort As Integer, Byval lpszUserName As _Offset, Byval lpszPassword As _Offset, Byval dwService As Long, Byval dwFlags As Long, Byval dwContext As _Offset)
Function HTTPOpenRequest%& Alias "HttpOpenRequestA" (ByVal hConnect As _Offset, Byval lpszVerb As _Offset, Byval lpszObjectName As _Offset, Byval lpszVersion As _Offset, Byval lpszReferrer As _Offset, Byval lpszAcceptTypes As _Offset, Byval dwFlags As Long, Byval dwContext As _Offset)
Function HTTPSendRequest%% Alias "HttpSendRequestA" (ByVal hRequest As _Offset, Byval lpszHeaders As _Offset, Byval dwHeadersLength As Long, Byval lpOptional As _Offset, Byval dwOptionalLength As Long)
Sub InternetCloseHandle (ByVal hInternet As _Offset)
Function InternetReadFile%% (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval dwNumberOfBytesToRead As Long, Byval lpdwNumberOfBytesRead As _Offset)
Function HTTPQueryInfo%% Alias "HttpQueryInfoA" (ByVal hRequest As _Offset, Byval dwInfoLevel As Long, Byval lpBuffer As _Offset, Byval lpdwBufferLength As _Offset, Byval lpdwIndex As _Offset)
End Declare
Declare Dynamic Library "Kernel32"
Function GetLastError& ()
Sub SetLastError (ByVal dwErrCode As Long)
Function FormatMessage& Alias "FormatMessageA" (ByVal dwFlags As Long, Byval lpSource As Long, Byval dwMessageId As Long, Byval dwLanguageId As Long, Byval lpBuffer As _Offset, Byval nSize As Long, Byval Arguments As _Offset)
End Declare
Declare Library
Function MAKELANGID& (ByVal p As Long, Byval s As Long)
End Declare
Screen _NewImage(480, 80, 32)
$ScreenHide
_ScreenHide
$Console
_Dest _Console
_Title "URL Downloader"
_ConsoleTitle "Enter Link"
Dim link As String
Dim filename As String
Do
Cls
Line Input "Link: ", link
Line Input "File Name : ", filename
Loop Until link <> "" And filename <> ""
_ScreenShow
_Title _Title$ + " - " + Mid$(filename, _InStrRev(filename, "\") + 1)
_Console Off
_Dest 0
DownloadLink link, filename
Sub DownloadLink (URL As String, File As String)
Dim As String URLFile
URLFile = URL
Dim As _Offset hsession
hsession = InternetOpen(0, INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
If hsession = 0 Then
Cls
Print "Error : InternetOpen", ErrorMessage(GetLastError)
InternetCloseHandle hsession
Exit Sub
End If
Dim As _Offset httpsession
URL = Mid$(URL, InStr(URL, "/") + 2)
URL = Mid$(URL, 1, InStr(URL, "/") - 1)
Dim As String intURL: intURL = URL + Chr$(0)
httpsession = InternetConnect(hsession, _Offset(intURL), INTERNET_DEFAULT_HTTPS_PORT, 0, 0, INTERNET_SERVICE_HTTP, 0, 0)
If httpsession = 0 Then
Cls
Print "Error : Internet Connect", ErrorMessage(GetLastError)
InternetCloseHandle hsession
Exit Sub
End If
Dim As _Offset httpRequest
Dim As String sessiontype, location, accepttypes
sessiontype = "GET" + Chr$(0)
location = Mid$(URLFile, InStr(URLFile, URL) + Len(URL)) + Chr$(0)
accepttypes = "*/*" + Chr$(0)
httpRequest = HTTPOpenRequest(httpsession, _Offset(sessiontype), _Offset(location), 0, 0, _Offset(accepttypes), INTERNET_FLAG_RELOAD Or INTERNET_FLAG_SECURE, 0)
If httpRequest = 0 Then
Cls
Print "Error : HTTPOpenRequest", ErrorMessage(GetLastError)
InternetCloseHandle hsession
Exit Sub
End If
Dim As Long sendrequest
Dim As String headers
headers = ""
sendrequest = HTTPSendRequest(httpRequest, 0, 0, 0, 0)
If sendrequest <> TRUE Then
Cls
Print "Error : HTTPSendRequest", ErrorMessage(GetLastError)
InternetCloseHandle hsession
Exit Sub
End If
Dim As _Byte query
Dim As String queryinfo
queryinfo = Space$(1024)
Dim As Long querylen
querylen = Len(queryinfo) - 1
query = HTTPQueryInfo(httpRequest, HTTP_QUERY_CONTENT_LENGTH, _Offset(queryinfo), _Offset(querylen), 0)
If query <> TRUE Then
Cls
Print "Error : HTTPQueryInfo", ErrorMessage(GetLastError)
InternetCloseHandle hsession
End If
Dim As _Unsigned _Integer64 bytesToRead
bytesToRead = Val(queryinfo)
Dim As String szBuffer
szBuffer = Space$(4097)
Dim As _Unsigned _Integer64 dwRead, bytesRead
If _FileExists(File) Then
Kill File
End If
Open File For Binary As #1
Dim As _Byte a
Dim As String filedownload
Dim As Long errr, bytesForRate
Dim x!
Dim y!
Dim Rate!
Dim As Single ratetime
Do
x! = Timer
a = InternetReadFile(httpRequest, _Offset(szBuffer), Len(szBuffer) - 1, _Offset(dwRead))
errr = GetLastError
If dwRead > 0 Then
filedownload = Mid$(szBuffer, 1, dwRead)
Put #1, , filedownload
bytesRead = bytesRead + dwRead
bytesForRate = bytesForRate + dwRead
ratetime = timeElapsedSince(x!)
If _Round(ratetime) >= 1 Then
Rate! = (bytesForRate / ratetime) / KILOBYTE
bytesForRate = 0
End If
Cls
Print "Downloading to " + File
If bytesToRead <> 0 Then
Select Case bytesRead
Case Is < KILOBYTE
Print Using "#### B downloaded of "; bytesRead;
Case Is < MEGABYTE And bytesRead >= KILOBYTE
Print Using "####.## KB downloaded of "; (bytesRead / KILOBYTE);
Case Is < GIGABYTE And bytesRead >= MEGABYTE
Print Using "####.## MB downloaded of "; (bytesRead / MEGABYTE);
Case Is < TERABYTE And bytesRead >= GIGABYTE
Print Using "####.## GB downloaded of "; (bytesRead / GIGABYTE);
End Select
Select Case bytesToRead
Case Is < KILOBYTE
Print Using "#### B"; bytesToRead
Case Is < MEGABYTE And bytesToRead >= KILOBYTE
Print Using "####.## KB"; (bytesToRead / KILOBYTE)
Case Is < GIGABYTE And bytesToRead >= MEGABYTE
Print Using "####.## MB"; (bytesToRead / MEGABYTE)
Case Is < TERABYTE And bytesToRead >= GIGABYTE
Print Using "####.## GB"; (bytesToRead / GIGABYTE)
End Select
Print Using "###.##%"; bytesRead / bytesToRead * 100
Else
Select Case bytesRead
Case Is < KILOBYTE
Print Using " #### B downloaded"; bytesRead
Case Is < MEGABYTE And bytesRead >= KILOBYTE
Print Using "####.## KB downloaded"; (bytesRead / KILOBYTE)
Case Is < GIGABYTE And bytesRead >= MEGABYTE
Print Using "####.## MB downloaded"; (bytesRead / MEGABYTE)
Case Is < TERABYTE And bytesRead >= GIGABYTE
Print Using "####.## GB downloaded"; (bytesRead / GIGABYTE)
End Select
End If
Select Case Rate!
Case Is < KILOBYTE
Print Using "Rate: #### Bps"; Rate!
Case Is < MEGABYTE And Rate! >= KILOBYTE
Print Using "Rate: ####.## KBps"; Rate! / KILOBYTE
Case Is < GIGABYTE And Rate! >= MEGABYTE
Print Using "Rate: ####.## MBps"; Rate! / MEGABYTE
Case Is < TERABYTE And Rate! >= GIGABYTE
Print Using "Rate: ####.## GBps"; Rate! / GIGABYTE
End Select
'Print "Rate="; _Round(Rate!); "KBps"
_Display
End If
Loop Until bytesRead = bytesToRead Or errr <> 0
If errr Then
Print "Error downloading file:"; errr
Close #1
InternetCloseHandle hsession
Kill File
Exit Sub
Else
End If
Close #1
InternetCloseHandle hsession
Cls
Select Case bytesRead
Case Is < KILOBYTE
Print Using "#### B downloaded of "; bytesRead;
Case Is < MEGABYTE And bytesRead >= KILOBYTE
Print Using "####.## KB downloaded of "; (bytesRead / KILOBYTE);
Case Is < GIGABYTE And bytesRead >= MEGABYTE
Print Using "####.## MB downloaded of "; (bytesRead / MEGABYTE);
Case Is < TERABYTE And bytesRead >= GIGABYTE
Print Using "####.## GB downloaded of "; (bytesRead / GIGABYTE);
End Select
Select Case bytesToRead
Case Is < KILOBYTE
Print Using "#### B"; bytesToRead
Case Is < MEGABYTE And bytesToRead >= KILOBYTE
Print Using "####.## KB"; (bytesToRead / KILOBYTE)
Case Is < GIGABYTE And bytesToRead >= MEGABYTE
Print Using "####.## MB"; (bytesToRead / MEGABYTE)
Case Is < TERABYTE And bytesToRead >= GIGABYTE
Print Using "####.## GB"; (bytesToRead / GIGABYTE)
End Select
Print Using "###.##%"; bytesRead / bytesToRead * 100
Print "Downloaded to " + File
End Sub
Function timeElapsedSince! (startTime!)
If startTime! > Timer Then startTime! = startTime! - 86400
timeElapsedSince! = Timer - startTime!
End Function
Function ErrorMessage$ (errCode As Long)
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H00000100
Const FORMAT_MESSAGE_FROM_SYSTEM = &H00001000
Const FORMAT_MESSAGE_IGNORE_INSERTS = &H00000200
Const LANG_NEUTRAL = &H00
Const SUBLANG_DEFAULT = &H01
Dim As _Offset lpMsgBuf
Dim As Long msg
msg = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or _
FORMAT_MESSAGE_FROM_SYSTEM Or _
FORMAT_MESSAGE_IGNORE_INSERTS, _
0, _
errCode, _
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _
_Offset(lpMsgBuf), _
0, 0)
ErrorMessage = pointerToString(lpMsgBuf)
End Function
Function pointerToString$ (pointer As _Offset)
Declare CustomType Library
Function strlen%& (ByVal ptr As _Unsigned _Offset)
End Declare
Dim As _Offset length: length = strlen(pointer)
If length Then
Dim As _MEM pString: pString = _Mem(pointer, length)
Dim As String ret: ret = Space$(length)
_MemGet pString, pString.OFFSET, ret
_MemFree pString
End If
pointerToString = ret
End Function