NEW NEW URL Downloader (All Platforms!)
#17
Huh. Actually kind of glad y'all brought back this post. Made me realize I had another bug in here as well. Now I should be able to unescape URLs a lot better:

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 _Unsigned _Integer64 totalSize
    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 Double y: y = Timer(0.001)
    While Not EOF(connection)
        Cls
        Dim As Long bytesForRate
        Get connection, , buf
        bytesForRate = bytesForRate + Len(buf)
        Put outfile, , buf
        totalSize = totalSize + Len(buf)
        If length > 0 Then
            Select Case totalSize
                Case Is < KILOBYTE
                    Print Using "#### B downloaded of "; totalSize;
                Case Is < MEGABYTE And totalSize >= KILOBYTE
                    Print Using "####.## KB downloaded of "; totalSize / KILOBYTE;
                Case Is < GIGABYTE And totalSize >= MEGABYTE
                    Print Using "####.## MB downloaded of "; totalSize / MEGABYTE;
                Case Is < TERABYTE And totalSize >= GIGABYTE
                    Print Using "####.## GB downloaded of "; totalSize / 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 totalSize
                Case Is < KILOBYTE
                    Print Using "#### B downloaded"; totalSize
                Case Is < MEGABYTE And LOF(outfile) >= KILOBYTE
                    Print Using "####.## KB downloaded"; totalSize / KILOBYTE
                Case Is < GIGABYTE And LOF(outfile) >= MEGABYTE
                    Print Using "####.## MB downloaded"; totalSize / MEGABYTE
                Case Is < TERABYTE And LOF(outfile) >= GIGABYTE
                    Print Using "####.## GB downloaded"; totalSize / GIGABYTE
            End Select
        End If
        Dim As Single Rate
        Dim As Double x: x = Timer(0.001) - y
        If x >= 1 Then
            Rate = (bytesForRate / x)
            bytesForRate = 0
            y = Timer(0.001)
        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

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)
    Dim As String before, after, newurl
    newurl = url
    Dim As _Unsigned _Byte code
    For code = 32 To 255
        If InStr(newurl, "%" + Hex$(code)) Then
            While InStr(newurl, "%" + Hex$(code))
                before = Mid$(newurl, 1, InStr(newurl, "%" + Hex$(code)) - 1)
                after = Mid$(newurl, InStr(newurl, "%" + Hex$(code)) + Len("%" + Hex$(code)))
                newurl = before + Chr$(code) + after
            Wend
        End If
    Next
    UnescapeURL = newurl
End Function
Schuwatch!
Yes, it's me. Now shut up.
Reply


Messages In This Thread
RE: NEW NEW URL Downloader (All Platforms!) - by Ultraman - 06-29-2023, 12:34 PM



Users browsing this thread: 4 Guest(s)