Login Guest
May 20, 2012, 3:01 pm UTCHome arrow Coding arrow Code Chunks arrow Get Online Status (Old)
header image
Get Online Status (Old)
Written by Dream Dancer   
Jul 23, 2010 at 02:32 AM

Yes, Old!

After looking at all the weird stuff you need to do in using a long GET request from a webserver, I stumbled on a means to just directly connect to the server and post the long request like that.

' online checker
 
$onlineserver = "on.furcadia.com"
$agentname = "FauxPawn 1.0"
GLOBAL ServerIndex  AS LONG
 
FUNCTION GetOnlineStatus(NamesIn AS STRING) AS STRING
LOCAL NamesOut, sError                          AS STRING
LOCAL hSession, hInternet, iResult, hRequest    AS DWORD
LOCAL zDomain, zPath, zVersion, zHeader         AS ASCIIZ * 256
LOCAL sGetData, HeaderBuffer, zReadBuffer       AS ASCIIZ * 8096
LOCAL iGetData                                  AS LONG
LOCAL dwBufferLength, lReturn                   AS LONG
LOCAL azErrorMsg, atErrorMsg                    AS ASCIIZ * 8096
LOCAL dwErrorMsg, dwErrorLen                    AS DWORD
 
    zDomain = $onlineserver
    IF ServerIndex > 1 THEN
        REPLACE "on." WITH "on"& FORMAT$(ServerIndex) &"." IN zDomain
    END IF
    INCR ServerIndex
    IF ServerIndex > 4 THEN ServerIndex = 1
    sGetData = "?"& NamesIn
    zPath = "/q/"
    zVersion = "HTTP/1.0"
    zHeader = "Content-Type: application/x-www-form-urlencoded" & $CRLF
    iGetData = LEN(sGetData)
    hSession = InternetOpen($agentname, %INTERNET_OPEN_TYPE_PRECONFIG, "", "", 0)
    IF hSession THEN
        hInternet = InternetConnect(hSession, zDomain, _
            %INTERNET_DEFAULT_HTTP_PORT, _
            "",  "", %INTERNET_SERVICE_HTTP, 0, 0)
        IF hInternet THEN
            iResult = 0
            hRequest = HttpOpenRequest(hInternet, "GET", "/q/", "HTTP/1.0", _
                "", iResult, _
                %INTERNET_FLAG_RELOAD OR %INTERNET_FLAG_NO_AUTO_REDIRECT, 0)
            IF hRequest THEN
                iResult = HttpAddRequestHeaders (hRequest, zHeader, -1, _
                    %HTTP_ADDREQ_FLAG_REPLACE OR %HTTP_ADDREQ_FLAG_ADD)
                iResult = HttpSendRequest(hRequest, "", 0, _
                    VARPTR(sGetData), iGetData)
                IF iResult THEN
                    dwBufferLength = SIZEOF(zReadBuffer)
                    'get the first chunk & buffer it.
                    iResult = InternetReadFile(hRequest, _
                        BYVAL VARPTR(zReadBuffer), dwBufferLength, lReturn)
                    NamesOut = NamesOut + MID$(zReadBuffer, 1, lReturn)
                    'if there's more data then keep reading it into the buffer
                    DO WHILE lReturn <> 0
                        iResult = InternetReadFile (hRequest,  _
                            BYVAL VARPTR(zReadBuffer), dwBufferLength, lReturn)
                        NamesOut = NamesOut & MID$(zReadBuffer, 1, lReturn)
                    LOOP
                    INCR FetchSuccess
                ELSE
                    sError = TIME$ &" Internet Returned "& HeaderBuffer
                    #DEBUG PRINT sError
                    NamesOut = HeaderBuffer
                    INCR FetchError
                END IF
            ELSE
            END IF
        ELSE
            dwErrorMsg = GetLastError()
            FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, _
                BYVAL %NULL, dwErrorMsg, _
                %NULL, atErrorMsg, SIZEOF(atErrorMsg), BYVAL %NULL
            sError = FORMAT$(dwErrorMsg) &":"& atErrorMsg
            FauxStatus.SetText "Failed to Open URL! "& sError, 0
            sError = TIME$ &" Failed to Open: "& sError
            #DEBUG PRINT sError
            NamesOut = "401"
            INCR FetchError
        END IF
    ELSE
        NamesOut = FORMAT$(GetLastError())
        FauxStatus.SetText "Failed to Find Internet! "& NamesOut, 0
    END IF
 
    InternetCloseHandle(hInternet)
    InternetCloseHandle(hSession)
 
    GetOnlineStatus = NamesOut
END FUNCTION
 

GeSHi parsed in 0.426740169525 seconds.

header image