11-23-2022, 05:15 PM
(This post was last modified: 11-23-2022, 07:01 PM by SpriggsySpriggs.
Edit Reason: Per Matt's recommendations, updated a few sections
)
So this is another URL downloader but using strictly QB64 code. No WinAPI stuff. This is using the latest code on the GitHub repo, not the latest release. Anyone who has Linux can also enjoy something I've made now. You'll need to clone the repo and build in order to run this code (for now). The program, like the last two URL downloaders, starts in a console screen so you can paste a link. After pressing Enter it will then switch to a regular QB64 screen to show the download progress. Using the latest GitHub source, this code supports both HTTP and HTTPS.
Code: (Select All)
Option Explicit
$NoPrefix
$Unstable:Http
Const KILOBYTE = 1024
Const MEGABYTE = KILOBYTE ^ 2
Const GIGABYTE = KILOBYTE ^ 3
Const TERABYTE = KILOBYTE ^ 4
Screen NewImage(480, 120, 32)
$ScreenHide
ScreenHide
$Console
Dest Console
Title "QB64 URL Downloader"
ConsoleTitle "Enter Link"
Dim As String link
Do
Cls
Line Input "Link: ", link
Loop Until link <> ""
ScreenShow
Title Title$ + " - " + link
Console Off
Dest 0
Dim As Long connection: connection = OpenClient("HTTP:" + link)
Dim As String buf
If connection <> 0 And StatusCode(connection) = 200 Then
Dim As Long length: length = LOF(connection)
Dim As String server, path
DivideURL link, path
Dim As String filepath: filepath = path
filepath = Mid$(filepath, InStrRev(filepath, "/") + 1)
If InStr(filepath, ".") Then filepath = Mid$(filepath, 1, InStrRev(filepath, ".") + 3)
If InStr(filepath, "?") Then filepath = Mid$(filepath, 1, InStr(filepath, "?") - 1)
Dim As Long outfile: outfile = FreeFile
filepath = UnescapeURL(filepath)
If FileExists(filepath) Then Kill filepath
Open "B", outfile, filepath
Dim As Single y: y = Timer
While Not EOF(connection)
Cls
Dim As Long bytesForRate
Get connection, , buf
bytesForRate = bytesForRate + Len(buf)
Put outfile, , buf
If length > 0 Then
Select Case LOF(outfile)
Case Is < KILOBYTE
Print Using "#### B downloaded of "; LOF(outfile);
Case Is < MEGABYTE And LOF(outfile) >= KILOBYTE
Print Using "####.## KB downloaded of "; LOF(outfile) / KILOBYTE;
Case Is < GIGABYTE And LOF(outfile) >= MEGABYTE
Print Using "####.## MB downloaded of "; LOF(outfile) / MEGABYTE;
Case Is < TERABYTE And LOF(outfile) >= GIGABYTE
Print Using "####.## GB downloaded of "; LOF(outfile) / GIGABYTE;
End Select
Select Case length
Case Is < KILOBYTE
Print Using "#### B"; length
Case Is < MEGABYTE And length >= KILOBYTE
Print Using "####.## KB"; length / KILOBYTE
Case Is < GIGABYTE And length >= MEGABYTE
Print Using "####.## MB"; length / MEGABYTE
Case Is < TERABYTE And length >= GIGABYTE
Print Using "####.## GB"; length / GIGABYTE
End Select
Else
Select Case LOF(outfile)
Case Is < KILOBYTE
Print Using "#### B downloaded"; LOF(outfile)
Case Is < MEGABYTE And LOF(outfile) >= KILOBYTE
Print Using "####.## KB downloaded"; LOF(outfile) / KILOBYTE
Case Is < GIGABYTE And LOF(outfile) >= MEGABYTE
Print Using "####.## MB downloaded"; LOF(outfile) / MEGABYTE
Case Is < TERABYTE And LOF(outfile) >= GIGABYTE
Print Using "####.## GB downloaded"; LOF(outfile) / GIGABYTE
End Select
End If
Dim As Single Rate
Dim As Integer x: x = Round(Timer - y)
If x = 1 Then
Rate = (bytesForRate / x)
bytesForRate = 0
y = Timer
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
Display
Limit 60
Wend
Close connection
Close outfile
Print "The resource was successfully retrieved"
Print "Saved to "; filepath
Else
Print "Could not connect or another error occurred"
End If
EscapeCodes:
Data "%20","%3C","%3E","%23","%25","%2B"
Data "%7B","%7D","%7C","%5C","%5E","%7E"
Data "%5B","%5D","%60","%3B","%2F","%3F"
Data "%3A","%40","%3D","%26","%24","EOD"
Sub DivideURL (url As String, path As String)
Dim As String server
If InStr(url, "http:") Or InStr(url, "https:") Then
server = Mid$(url, InStr(url, "/") + 2)
If InStr(server, "/") Then
server = Mid$(server, 1, InStr(server, "/") - 1)
End If
Else
If InStr(url, "/") Then
server = Mid$(url, 1, InStr(url, "/") - 1)
End If
End If
path = Mid$(url, InStr(url, server) + Len(server))
End Sub
Function UnescapeURL$ (url As String)
Restore EscapeCodes
Dim As String code, before, after, newurl
newurl = url
Read code
While code <> "EOD"
If InStr(newurl, code) Then
While InStr(newurl, code)
before = Mid$(newurl, 1, InStr(newurl, code) - 1)
after = Mid$(newurl, InStr(newurl, code) + Len(code))
newurl = before + Chr$(Val("&H" + Mid$(code, 2))) + after
Wend
End If
Read code
Wend
UnescapeURL = newurl
End Function
Ask me about Windows API and maybe some Linux stuff