#INCLUDE "winhttp.bi"
#INCLUDE "http-client.bi"
'Implement friendly interfaces to interact with WinHTTP api
CONST AS STRING IguanaUserAgent = "IguanaCMS HTTP Client/1.0"
DIM SHARED AS ULONG PTR SessionHandler, ConnectionHandler, RequestHandler
DIM SHARED RequestMethod AS STRING, ResponseHeaders() AS STRING, ResponseReceived AS LONG
FUNCTION IsValidMethod(CurrentMethod AS STRING) AS BYTE
DIM ArrayMethods(HTTP_Methods.Count - 1) AS STRING = { _
"HEAD", "GET", "POST", "PUT", "DELETE" _
}
FOR i AS ULONG = 0 TO HTTP_Methods.Count - 1
IF UCASE(CurrentMethod) = ArrayMethods(i) THEN
IsValidMethod = -1
EXIT FOR
END IF
NEXT
END FUNCTION
FUNCTION SplitUrl(FullUrl AS STRING, UrlPart AS URL_Properties) AS STRING
IF FullUrl <> "" AND UrlPart < URL_Properties.Count THEN
DIM Result AS STRING
DIM AS ULONG ColonPos, DoubleSlashPos, PathStartPos
ColonPos = INSTR(FullUrl, ":")
DoubleSlashPos = INSTR(FullUrl, "//")
SELECT CASE UrlPart
CASE URL_Protocol
Result = MID(FullUrl, 1, ColonPos - 1)
CASE URL_HostName
PathStartPos = INSTR(DoubleSlashPos + 2, FullUrl, "/")
Result = MID(FullUrl, DoubleSlashPos + 2, PathStartPos - DoubleSlashPos - 2)
CASE URL_Port
ColonPos = INSTR(ColonPos + 1, FullUrl, ":")
IF ColonPos THEN
'Another colon found?, must be the port number
PathStartPos = INSTR(ColonPos, FullUrl, "/")
Result = MID(FullUrl, ColonPos + 1, PathStartPos - ColonPos - 1)
END IF
CASE URL_URI
PathStartPos = INSTR(DoubleSlashPos + 2, FullUrl, "/")
Result = MID(FullUrl, PathStartPos)
'CASE URL_QueryString
'CASE URL_Fragment
END SELECT
SplitUrl = Result
END IF
END FUNCTION
SUB ParseResponseHeaders(HeadersContent AS STRING)
IF HeadersContent <> "" THEN
DIM Char AS UBYTE, LineCount AS ULONG
DIM AS STRING CleanHeaders, NewLine = CHR(13, 10)
FOR i AS ULONG = 1 TO LEN(HeadersContent)
Char = ASC(MID(HeadersContent, i, 1))
SELECT CASE Char
CASE 0
i += 2
CASE 10
CleanHeaders += CHR(Char)
i += 1
LineCount += 1
CASE ELSE
CleanHeaders += CHR(Char)
i += 1
END SELECT
NEXT
IF LineCount THEN
DIM AS ULONG IndexPos, NextPos, StartPos = 1
REDIM ResponseHeaders(LineCount - 1)
NextPos = StartPos
WHILE NextPos
NextPos = INSTR(StartPos, CleanHeaders, NewLine)
ResponseHeaders(IndexPos) = MID(CleanHeaders, StartPos, NextPos - StartPos)
IndexPos += 1
StartPos = NextPos + 2
WEND
END IF
END IF
END SUB
SUB GetResponseHeaders()
'Partially based on http://www.jose.it-berater.org/winhttp/winhttpqueryheaders.htm
IF RequestHandler THEN
DIM ResponseContent AS STRING, ResponseLen AS ULONG, QueryFlag AS ULONG
'Fail the first attemtp, but gain the buffer length
IF NOT WinHttpQueryHeaders( _
RequestHandler, _
WINHTTP_QUERY_RAW_HEADERS_CRLF, _
WINHTTP_HEADER_NAME_BY_INDEX, _
WINHTTP_NO_OUTPUT_BUFFER, _
VarPtr(ResponseLen), _
WINHTTP_NO_HEADER_INDEX _
) THEN
LastError = GetLastError()
IF LastError = ERROR_INSUFFICIENT_BUFFER THEN
ResponseContent = SPACE(ResponseLen)
'Now we know the size, get full headers
IF WinHttpQueryHeaders( _
RequestHandler, _
WINHTTP_QUERY_RAW_HEADERS_CRLF, _
WINHTTP_HEADER_NAME_BY_INDEX, _
ResponseContent, _
VarPtr(ResponseLen), _
WINHTTP_NO_HEADER_INDEX _
) THEN
ParseResponseHeaders(ResponseContent)
END IF
END IF
END IF
END IF
END SUB
FUNCTION HTTP_GetResponseHeader(HeaderName AS STRING) AS STRING
IF HeaderName <> "" AND UBOUND(ResponseHeaders) >= 0 THEN
FOR i AS ULONG = 0 TO UBOUND(ResponseHeaders)
IF LCASE(HeaderName) = "status" THEN
IF INSTR(ResponseHeaders(i), "HTTP") THEN
HTTP_GetResponseHeader = MID(ResponseHeaders(i), LEN("HTTP/1.1") + 1)
EXIT FOR
END IF
ELSE
IF LCASE(HeaderName) = LCASE(RTRIM(MID(ResponseHeaders(i), 1, INSTR(ResponseHeaders(i), ":") - 1))) THEN
HTTP_GetResponseHeader = LTRIM(MID(ResponseHeaders(i), INSTR(ResponseHeaders(i), ":") + 1))
EXIT FOR
END IF
END IF
NEXT
END IF
END FUNCTION
SUB HTTP_Open(Method AS STRING, Url AS STRING)
DIM AS ULONG ServerPort, RequestFlags
DIM AS STRING ServerProtocol
IF Method <> "" AND IsValidMethod(Method) THEN
RequestMethod = UCASE(Method)
ELSE
RequestMethod = "GET"
END IF
SessionHandler = WinHttpOpen( _
WSTR(IguanaUserAgent), _
WINHTTP_ACCESS_TYPE_NO_PROXY, _
WINHTTP_NO_PROXY_NAME, _
WINHTTP_NO_PROXY_BYPASS _
)
IF SessionHandler THEN
ServerProtocol = SplitUrl(Url, URL_Protocol)
ServerPort = VALINT(SplitUrl(Url, URL_Port))
IF NOT ServerPort THEN
'Port empty, use default ones
SELECT CASE ServerProtocol
CASE "http"
ServerPort = INTERNET_DEFAULT_HTTP_PORT
CASE "https"
ServerPort = INTERNET_DEFAULT_HTTPS_PORT
END SELECT
END IF
ConnectionHandler = WinHttpConnect( _
SessionHandler, _
WSTR(SplitUrl(Url, URL_HostName)), _
ServerPort _
)
IF ConnectionHandler THEN
SELECT CASE ServerProtocol
CASE "http"
RequestFlags = WINHTTP_FLAG_REFRESH
CASE "https"
RequestFlags = WINHTTP_FLAG_REFRESH OR WINHTTP_FLAG_SECURE
END SELECT
RequestHandler = WinHttpOpenRequest( _
ConnectionHandler, _
WSTR(Method), _
WSTR(SplitUrl(Url, URL_URI)), _
0, _
WINHTTP_NO_REFERER, _
WINHTTP_DEFAULT_ACCEPT_TYPES, _
RequestFlags _
)
END IF
END IF
END SUB
SUB HTTP_SetRequestHeader(HeaderName AS STRING, HeaderValue AS STRING)
IF RequestHandler THEN
IF HeaderName <> "" AND HeaderValue <> "" THEN
DIM CompleteHeader AS STRING
CompleteHeader = HeaderName + ": " + HeaderValue
IF NOT WinHttpAddRequestHeaders( _
RequestHandler, _
WSTR(CompleteHeader), _
LEN(WSTR(CompleteHeader)), _
0 _
) THEN
LastError = GetLastError()
END IF
END IF
END IF
END SUB
SUB HTTP_Send(RequestBody AS STRING = "")
IF RequestHandler THEN
DIM RequestFlags AS ULONG, ReTry AS LONG, RequestLen AS ULONG, RequestData AS STRING
IF RequestBody <> "" AND RequestMethod = "POST" OR RequestMethod = "PUT" THEN
RequestData = RequestBody
RequestLen = LEN(RequestData)
END IF
DO
ReTry = 0
IF WinHttpSendRequest( _
RequestHandler, _
WINHTTP_NO_ADDITIONAL_HEADERS, _
0, _
StrPtr(RequestData), _
RequestLen, _
RequestLen, _
0 _
) THEN
ResponseReceived = WinHttpReceiveResponse(RequestHandler)
IF ResponseReceived THEN
GetResponseHeaders()
END IF
ELSE
LastError = GetLastError()
IF LastError THEN
SELECT CASE LastError
CASE ERROR_WINHTTP_SECURE_INVALID_CA
RequestFlags = _
SECURITY_FLAG_IGNORE_UNKNOWN_CA OR _
SECURITY_FLAG_IGNORE_CERT_WRONG_USAGE OR _
SECURITY_FLAG_IGNORE_CERT_CN_INVALID OR _
SECURITY_FLAG_IGNORE_CERT_DATE_INVALID
IF WinHttpSetOption( _
RequestHandler, _
WINHTTP_OPTION_SECURITY_FLAGS, _
VarPtr(RequestFlags), _
LEN(RequestFlags) _
) THEN
ReTry = -1
END IF
CASE ELSE
ReTry = 0
END SELECT
END IF
END IF
LOOP WHILE ReTry
END IF
END SUB
FUNCTION HTTP_GetResponse() AS STRING
IF ResponseReceived THEN
DIM AS STRING ResponseText, TempResponse
DIM AS ULONG SavedLen, CharsLeft
DO
CharsLeft = 0
IF WinHttpQueryDataAvailable(RequestHandler, VarPtr(CharsLeft)) THEN
CharsLeft += 1
TempResponse = SPACE(CharsLeft)
IF WinHttpReadData( _
RequestHandler, _
StrPtr(TempResponse), _
CharsLeft, _
VarPtr(SavedLen) _
) THEN
ResponseText += TempResponse
END IF
END IF
LOOP UNTIL CharsLeft = 0
HTTP_GetResponse = ResponseText
END IF
END FUNCTION
SUB HTTP_Clean()
IF RequestHandler THEN
WinHttpCloseHandle(RequestHandler)
END IF
IF ConnectionHandler THEN
WinHttpCloseHandle(ConnectionHandler)
END IF
IF SessionHandler THEN
WinHttpCloseHandle(SessionHandler)
END IF
END SUB