URL Downloader

[SpriggsySpriggs]

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