'****************************************************************************
'
' Webget       : Webget with Authentication and HTTP/1.1 support
' Version      : v1.82
' Compilation  : Thomas Gohel (gohel@basicguru.de)
' Last Files at: http://www.pbhq.de
'
' Description  : "."  = received block
'                "["  = begin of a internal loop (requested chunksize >
'                       internal chunksizelimit / chunksizemax)
'                "]"  = end of internal loop
'                "f"  = failure handled (internal loop)
'                "F"  = failure handled (receveid Bytes <> requested bytes)
'
' Next Version : I hope "Auth-Digest" and "Keep-Alive" Support and no fixes
'
'****************************************************************************

$COMPILE EXE
$DIM ALL
$INCLUDE "WIN32API.INC"

DECLARE FUNCTION WebGet(BYVAL Webserver AS STRING, BYVAL WebUrl AS STRING, BYVAL KeepAlive AS LONG, _
                        BYVAL Username AS STRING, BYVAL Password AS STRING, BYVAL LocalFile AS STRING) AS LONG
DECLARE FUNCTION Get_Base64_Encode(szUnEncoded AS STRING) AS STRING

'-------------------------------------------------------------------------------------------
' Web, Get Page / Seite anfordern
'-------------------------------------------------------------------------------------------
FUNCTION WebGet(BYVAL Webserver AS STRING, BYVAL WebUrl AS STRING, BYVAL KeepALive AS LONG, _
                BYVAL Username AS STRING, BYVAL Password AS STRING, BYVAL LocalFile AS STRING) AS LONG

        STATIC hWeb         AS LONG       ' TCP/IP Handle
        STATIC hWebGlobal   AS LONG       '
        STATIC ConnServer   AS STRING
        STATIC ConnAlive    AS STRING     '
        LOCAL hFile         AS LONG       ' File Handle
        LOCAL Response      AS STRING     ' Response of the Webserver
        LOCAL HTTP          AS LONG       ' HTTP-Version
        LOCAL ContentLen    AS LONG
        LOCAL Chunked       AS STRING
        LOCAL ChunkSize     AS LONG       '
        LOCAL ChunkSizeMax  AS LONG       '
        LOCAL ChunkDiff     AS LONG       '
        LOCAL ChunkHdrByte  AS BYTE PTR
        LOCAL ChunkHead     AS STRING     '
        LOCAL HtmlPage      AS STRING     ' Html-Page
        LOCAL Header        AS STRING     ' Header of Html-Page
        LOCAL Body          AS STRING     ' Body of Html-Page
        LOCAL AuthInfo      AS STRING     '
        LOCAL PBVer         AS STRING
        LOCAL i             AS LONG       ' Counter
        LOCAL s             AS STRING     ' Temp

        FUNCTION = 0

        ON ERROR RESUME NEXT

        HTTP     = 10                     ' for HTTP/1.1 (use 10 for HTTP/1.0)
        PBVer$    = TRIM$(HEX$(%PB_REVISION))

        PRINT
        PRINT
        PRINT "Request " & $DQ & "http://" & Webserver & WebUrl & $DQ & " to " & $DQ & LocalFile & $DQ
        PRINT

        ' some tests
        IF KeepAlive = %True THEN
           IF LEN(ConnServer) > 0 THEN
               IF WebServer <> ConnServer THEN
                   ConnAlive  = ""
                   ConnServer = ""
               END IF
            END IF
        END IF

        IF FREEFILE <> 0 THEN
            IF hWebGlobal > 0 AND ConnAlive = "keep-alive" THEN
                PRINT "Keep-Alive Connection"
            ELSE
                hWeb = FREEFILE
                TCP OPEN PORT 80 AT WebServer$ AS hWeb TIMEOUT 10000
            END IF
            hWebGlobal = FILEATTR(hWeb,2)
            IF hWebGlobal > 0 THEN
                IF HTTP = 10 THEN
                    TCP PRINT hWeb, "GET " & TRIM$(WebUrl) & " HTTP/1.0"
                ELSE
                    TCP PRINT hWeb, "GET " & TRIM$(WebUrl) & " HTTP/1.1"
                END IF
                TCP PRINT hWeb, "Host: " & WebServer
                TCP PRINT hWeb, "Referer: " & "http://" & WebServer
                TCP PRINT hWeb, "User-Agent: Webget/1.82 (http://www.pbhq.de/pbtools/webget/; PowerBASIC/CC " & _
                                 LEFT$(PBVer$, 1) + "." + RIGHT$(PBVer$, 2) & ")"
                TCP PRINT hWeb, "Accept: */*"
                TCP PRINT hWeb, "Accept-Language: de-de,de;q=0.8,en-us;q=0.5,en;q=0.3"
                IF KeepAlive = %True THEN
                    TCP PRINT hWeb, "Keep-Alive: 300"
                    TCP PRINT hWeb, "Connection: keep-alive"
                END IF
                IF KeepAlive = %False AND ConnAlive = "keep-alive" THEN
                    TCP PRINT hWeb, "Connection: close"
                END IF
                IF Username <> "" AND Password <> "" THEN
                    TCP PRINT hWeb, "Authorization: Basic " & Get_Base64_Encode(Username & ":" & Password)
                END IF
                TCP PRINT hWeb, ""

                ' Get Header
                DO
                    TCP LINE #hWeb, Header
                    PRINT Header
                    IF LEFT$(Header, 4) = "HTTP" THEN
                        Response = PARSE$(Header, " ", 2)
                        Authinfo = PARSE$(Header, " ", 3) & " " & PARSE$(Header, " ", 4) & " " & PARSE$(Header, " ", 5)
                    END IF
                    IF LCASE$(LEFT$(Header, 17)) = "www-authenticate:" THEN
                        i = INSTR(Header, "realm=")
                        Authinfo = Authinfo & "for " & MID$(Header, i + 6)
                    END IF
                    IF LCASE$(LEFT$(Header, 18)) = "transfer-encoding:" THEN
                        Chunked = TRIM$(LCASE$(MID$(Header$, 20)))
                    END IF
                    IF LCASE$(LEFT$(Header, 15)) = "content-length:" THEN
                        ContentLen = VAL(TRIM$(MID$(Header$, 17)))
                    END IF
                    IF LCASE$(LEFT$(Header, 11)) = "connection:" THEN
                        ConnAlive  = TRIM$(LCASE$(MID$(Header$, 13)))
                        ConnServer = WebServer
                    END IF
                LOOP UNTIL Header$ = "" OR Header$ = " "

                ' Get Body
                IF Response = "200" THEN
                    PRINT Response & " " & Authinfo
                    OPEN LocalFile FOR BINARY AS #hFile
                        IF Chunked = "chunked" THEN
                            PRINT "Downloading Chunks ";
                            ChunkSizeMax = 2048 * 16
                            DO
                                ChunkHead = ""
                                DO
                                    TCP RECV #hWeb, 1, Body
                                    ChunkHead = ChunkHead + Body
                                LOOP UNTIL Body = $LF
                                ' Fill String
                                ChunkHead = STRING$(8 - (LEN(ChunkHead$) - 2), "0") + LEFT$(ChunkHead$, LEN(ChunkHead) - 2)
                                ' Calculate Chunk-Lenght from String
                                ChunkHdrByte = VARPTR(ChunkSize)
                                FOR i = 8 TO 1 STEP - 2
                                    @ChunkHdrByte = VAL("&h0" & MID$(ChunkHead$, i-1, 2))
                                    INCR ChunkHdrByte
                                NEXT i
                                'PRINT ChunkHead, ChunkSize
                                ContentLen = ChunkSize

                                IF ContentLen > ChunkSizeMax THEN
                                    PRINT "[";
                                    DO
                                        PRINT ".";
                                        TCP RECV #hWeb, ChunkSizeMax, Body
                                        ChunkDiff = ChunkSizeMax - LEN(Body)
                                        IF ChunkDiff > 0 THEN PRINT "f";
                                        PUT$ #hFile, Body
                                        ContentLen = ContentLen - ChunkSizeMax + ChunkDiff
                                    LOOP WHILE ContentLen => ChunkSizeMax
                                    PRINT "]";
                                END IF
                                PRINT ".";
                                DO
                                    TCP RECV #hWeb, ContentLen, Body
                                    PUT$ #hFile, Body
                                    ChunkDiff = ContentLen - LEN(Body)
                                    IF ChunkDiff > 0 THEN PRINT "F";
                                    ContentLen = ChunkDiff
                                LOOP UNTIL ContentLen = 0
                                TCP RECV #hWeb, 2, Body
                            LOOP UNTIL ChunkSize = 0
                        ELSE
                            IF ContentLen > 0 THEN
                               ' faster method with HTTP 1.1
                                PRINT "Downloading" & STR$(ContentLen) & " Bytes ";
                                ChunkSizeMax = 2048 * 16
                                IF ContentLen > ChunkSizeMax THEN
                                    PRINT "[";
                                    DO
                                        PRINT ".";
                                        TCP RECV #hWeb, ChunkSizeMax, Body
                                        ChunkDiff = ChunkSizeMax - LEN(Body)
                                        IF ChunkDiff > 0 THEN PRINT "f";
                                        PUT$ #hFile, Body
                                        ContentLen = ContentLen - ChunkSizeMax + ChunkDiff
                                    LOOP WHILE ContentLen => ChunkSizeMax
                                    PRINT "]";
                                END IF
                                PRINT ".";
                                DO
                                    TCP RECV #hWeb, ContentLen, Body
                                    PUT$ #hFile, Body
                                    ChunkDiff = ContentLen - LEN(Body)
                                    IF ChunkDiff > 0 THEN PRINT "F";
                                    ContentLen = ChunkDiff
                                LOOP UNTIL ContentLen = 0
                            ELSE
                                ' older HTTP 1.0 method
                                PRINT "Downloading unknown Bytes ";
                                ChunkSizeMax = 2048 * 16
                                DO
                                    PRINT ".";
                                    TCP RECV #hWeb, ChunkSizeMax, Body
                                    PUT$ hFile, Body
                                LOOP WHILE LEN(Body)
                            END IF
                        END IF
                        SETEOF(hFile)
                    CLOSE #hFile
                    FUNCTION = 0
                ELSE
                    PRINT Response & " " & Authinfo
                    FUNCTION = VAL(Response)
                END IF
                SELECT CASE ConnAlive
                    CASE "keep-alive"
                        PRINT "K";
                    CASE "close"
                        TCP CLOSE #hWeb
                        PRINT "C";
                    CASE ELSE
                        TCP CLOSE #hWeb
                        PRINT "K";
                END SELECT
            ELSE
                PRINT "Host not found"
            END IF
        END IF

        EXIT FUNCTION

WebGetError:
        PRINT
        PRINT "Error"; ERRAPI; ERR; "- "; ERROR$(ERR)

END FUNCTION

'-------------------------------------------------------------------------------------------
' Base64 - String codieren
'-------------------------------------------------------------------------------------------
FUNCTION Get_Base64_Encode(szUnEncoded AS STRING) AS STRING

        DIM icChopMask  AS LOCAL INTEGER  ' Constant 8-bit mask (Faster than using string constants)
        DIM icBitShift  AS LOCAL INTEGER  ' Constant shift mask (Faster than using string constants)
        DIM icStartMask AS LOCAL INTEGER  ' Initial mask value  (Faster than using string constants)
        DIM iRollOver   AS LOCAL INTEGER  ' Decoded Roll over value
        DIM iHighMask   AS LOCAL INTEGER  ' Mask high bits of each char
        DIM iShift      AS LOCAL INTEGER  ' Multiplier shift value
        DIM iLowShift   AS LOCAL INTEGER  ' Mask low bits of each char
        DIM szAlphabet  AS LOCAL STRING   ' Decode/Encode Lookup Table
        DIM szTemp      AS LOCAL STRING   ' Working string
        DIM iPtr        AS LOCAL INTEGER
        DIM iChar       AS LOCAL INTEGER
        DIM iCounter    AS LOCAL INTEGER
        DIM icLowFill   AS LOCAL INTEGER
        DIM iLowMask    AS LOCAL INTEGER

        ' If Empty, return NUL
        IF LEN(szUnEncoded) = 0 THEN
            FUNCTION = ""
        ELSE
            ' Initialize lookup dictionary and constants
            szAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
            icBitShift = 4
            icChopMask = 255
            icLowFill  = 3
            szTemp     = ""    ' Initialize Masks
            iHighMask  = &HFC
            iLowMask   = &H3
            iShift     = &H10
            iRollOver  = 0

            ' Begin Encoding process
            FOR iCounter = 1 TO LEN(szUnEncoded)
                ' Fetch ascii character in decoded string
                iChar = ASC(szUnEncoded, iCounter)
                ' Calculate Alphabet lookup pointer
                iPtr = ((iChar AND iHighMask) \ (iLowMask + 1)) OR iRollOver
                ' Roll bit patterns
                iRollOver = (iChar AND iLowMask) * iShift
                ' Concatenate encoded character to working encoded string
                szTemp = szTemp + MID$(szAlphabet, iPtr + 1, 1)
                ' Adjust masks
                iHighMask = (iHighMask * icBitShift) AND icChopMask
                iLowMask = iLowMask * icBitShift + icLowFill
                iShift = iShift \ icBitShift
                ' If last character in block, concat last RollOver and
                '   reset masks
                IF iHighMask = 0 THEN
                    szTemp = szTemp + MID$(szAlphabet, iRollOver + 1, 1)
                    iRollOver = 0
                    iHighMask = &HFC
                    iLowMask  = &H3
                    iShift    = &H10
                END IF
            NEXT iCounter

            ' If RollOver remains, concat it to the working string
            IF iShift < &H10 THEN
                szTemp = szTemp + MID$(szAlphabet, iRollOver + 1, 1)
            END IF
            ' Pad encoded string with required '=' pad characters
            iPtr = (LEN(szTemp) MOD 4)
            IF iPtr THEN
                szTemp = szTemp + STRING$(4 - iPtr, "=")
            END IF
            FUNCTION = szTemp
        END IF
END FUNCTION


FUNCTION PBMAIN() AS LONG

        LOCAL Response AS LONG
        LOCAL HtmlPage AS STRING

        PRINT
        PRINT "Webget v1.82 for PowerBASIC" & SPACE$(21) & "(c) 2000-2006 by Thomas Gohel"
        PRINT SPACE$(38) & "gohel@basicguru.de - http://www.pbhq.de"
        PRINT "

        ' *** Demonstration for Auth-Basic with Content-Lenght (HTTP/1.1, incl. Error-Responses)
        'Response = WebGet("www.pbhq.de", "/pbtools/webget/auth-basic/webget.bas", %False, "", "", "TEST.BAS")
        'Response = WebGet("www.pbhq.de", "/pbtools/webget/auth-basic/webget.bas", %False, "powerbasic", "webget", "TEST.BAS")

        ' *** Demonstration for Auth-Basic with Content-Lenght (HTTP/1.1), larger File)
        'Response = WebGet("www.pbhq.de", "/pbtools/webget/auth-basic/e-mail.inc", %False, "powerbasic", "webget", "TEST.INC")

        ' *** Demonstration for Content-Lenght (HTTP/1.1)
        'Response = WebGet("www.pbhq.de", "/pbtools/webget/webget.bas", %False, "", "", "TEST.BAS")

        ' *** Demonstration for Content-Lenght (HTTP/1.1), larger ZIP-File)
        ' Response = WebGet("www.pbhq.de", "/pbmail/pbmail.zip", %False, "", "", "TEST.ZIP")

        '*** Demonstration for Chunks (HTTP/1.1)
        'Response = WebGet("www.pbhq.de", "/filebase/fdb201.html", %False, "", "", "TEST.html")

        '*** Demonstration for Keep-Alive (HTTP/1.1, incl. server change)
        Response = WebGet("www.pbhq.de", "/pbtools/webget/webget.bas", %True, "", "", "TEST1.BAS")
        Response = WebGet("www.pbhq.de", "/pbtools/webget/webget.bas", %True, "", "", "TEST2.BAS")
        Response = WebGet("www.pbhq.de", "/pbtools/webget/webget.bas", %False, "", "", "TEST3.BAS")

        PRINT
        PRINT
        PRINT "Any key to continue ..."
        WAITKEY$

END FUNCTION