Send an Arbitrary HTTP Request (Windows only)

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Send an Arbitrary HTTP Request (Windows only)

Post by KristopherWindsor »

This code uses WinINet, thanks to this post by Zippy and Google searching.

By "arbitrary" I mean that here you can set the request method, add headers, and set the body. WinINet itself will also add some headers to the request, I suppose.

Here's the code:

Code: Select all

#undef data
#include once "windows.bi"
#include once "win\wininet.bi"

Type http_response
  Declare Function toString() As String
  
  As Integer status
  As String headers, body
End Type

Type http_request
  Declare Constructor( _
    host As String, _
    url As String = "", _
    method As String = "", _
    headers As String = "", _
    body As String = "" _
  )
  Declare Function send() As http_response
  
  As String host
  As String url, method
  As String headers, body
End Type

Constructor http_request( _
    host As String, _
    url As String = "", _
    method As String = "", _
    headers As String = "", _
    body As String = "" _
  )
  With this
    .host = host
    .url = url
    .method = method
    .headers = headers
    .body = body
  End With
End Constructor

Function http_request.send() As http_response
  Dim As String userAgent = "KristopherWindsor"
  Dim As Ubyte char
  Dim As Integer bytesRead, bufferSize, timeout
  Dim As String buffer
  Dim As http_response res
  Dim As HINTERNET internet, connection, request
  
  internet = InternetOpen(userAgent, INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0)
  If internet = 0 Then Goto theend
  
  connection = InternetConnect(internet, Strptr(host), INTERNET_DEFAULT_HTTP_PORT, NULL, NULL, INTERNET_SERVICE_HTTP, 0, NULL)
  If connection = 0 Then Goto theend
  
  request = HttpOpenRequest(connection, method, url, NULL, NULL, NULL, 0, 0)
  If request = 0 Then Goto theend
  timeout = 600000
  InternetSetOption(request, INTERNET_OPTION_RECEIVE_TIMEOUT, @timeout, sizeof(integer))
  
  If HttpSendRequest(request, strptr(headers), Len(headers), Strptr(body), Len(body)) Then
    bufferSize = 10000
    buffer = Space(bufferSize)
    HttpQueryInfo(request, HTTP_QUERY_RAW_HEADERS_CRLF, Strptr(buffer), @bufferSize, 0)
    res.headers += Left(buffer, bufferSize)
    HttpQueryInfo(request, HTTP_QUERY_STATUS_CODE, Strptr(buffer), @bufferSize, 0)
    res.status = Val(Left(buffer, bufferSize))
    
    Do
      InternetReadFile(request, @char, 1, @bytesRead)
      If bytesRead = 0 Then Exit Do
      res.body += Chr(char)
    Loop
  End If
  
  theend:
  If internet Then InternetCloseHandle(internet)
  If connection Then InternetCloseHandle(connection)
  If request Then InternetCloseHandle(request)
  
  Return res
End Function

Function http_response.toString() As String
  Return headers & body
End Function
And here's the same code with an example usage at the bottom:

Code: Select all

#undef data
#include once "windows.bi"
#include once "win\wininet.bi"

Type http_response
  Declare Function toString() As String
  
  As Integer status
  As String headers, body
End Type

Type http_request
  Declare Constructor( _
    host As String, _
    url As String = "", _
    method As String = "", _
    headers As String = "", _
    body As String = "" _
  )
  Declare Function send() As http_response
  
  As String host
  As String url, method
  As String headers, body
End Type

Constructor http_request( _
    host As String, _
    url As String = "", _
    method As String = "", _
    headers As String = "", _
    body As String = "" _
  )
  With this
    .host = host
    .url = url
    .method = method
    .headers = headers
    .body = body
  End With
End Constructor

Function http_request.send() As http_response
  Dim As String userAgent = "KristopherWindsor"
  Dim As Ubyte char
  Dim As Integer bytesRead, bufferSize, timeout
  Dim As String buffer
  Dim As http_response res
  Dim As HINTERNET internet, connection, request
  
  internet = InternetOpen(userAgent, INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0)
  If internet = 0 Then Goto theend
  
  connection = InternetConnect(internet, Strptr(host), INTERNET_DEFAULT_HTTP_PORT, NULL, NULL, INTERNET_SERVICE_HTTP, 0, NULL)
  If connection = 0 Then Goto theend
  
  request = HttpOpenRequest(connection, method, url, NULL, NULL, NULL, 0, 0)
  If request = 0 Then Goto theend
  timeout = 600000
  InternetSetOption(request, INTERNET_OPTION_RECEIVE_TIMEOUT, @timeout, Sizeof(Integer))
  
  If HttpSendRequest(request, Strptr(headers), Len(headers), Strptr(body), Len(body)) Then
    bufferSize = 10000
    buffer = Space(bufferSize)
    HttpQueryInfo(request, HTTP_QUERY_RAW_HEADERS_CRLF, Strptr(buffer), @bufferSize, 0)
    res.headers += Left(buffer, bufferSize)
    HttpQueryInfo(request, HTTP_QUERY_STATUS_CODE, Strptr(buffer), @bufferSize, 0)
    res.status = Val(Left(buffer, bufferSize))
    
    Do
      InternetReadFile(request, @char, 1, @bytesRead)
      If bytesRead = 0 Then Exit Do
      res.body += Chr(char)
    Loop
  End If
  
  theend:
  If internet Then InternetCloseHandle(internet)
  If connection Then InternetCloseHandle(connection)
  If request Then InternetCloseHandle(request)
  
  Return res
End Function

Function http_response.toString() As String
  Return headers & body
End Function

'example usage

Dim As http_request request = http_request("api.jafile.com", "/kristopherwindsor/screen/", "GET")
'note: you can set the request headers and the body at this point
'form data is sent as var1=val1&var2=val2
'binary data (eg PUTting a file to a REST API): just put all the data in the body string

Dim As http_response response = request.send()

Print "Status: " & response.status
Print response.body
Sleep()
And here's a real example, which gets Janumber (for Jafile):

Code: Select all

function getJanumber(prefix as string, suffix as string) as integer
  Dim As http_request getja = http_request(host, "/" & username & "/janumber?" & auth, "POST")
  Dim As http_request fileexists = http_request(host,, "HEAD")
  dim as integer janumber
  Do
    var res = getja.send()
    If res.status <> 200 Then bad()
    janumber = Val(res.body)
    fileexists.url = "/" & username & prefix & janumber & suffix
    If fileexists.send().status = 404 Then Exit Do
  Loop
  return janumber
end function
Sebastian
Posts: 131
Joined: Jun 18, 2005 14:01
Location: Europe / Germany
Contact:

Post by Sebastian »

Very simple snippet to perform "low-level" HTTP POST requests without being bound to WinAPI/WinINet (using TSNE): httppost_en.zip (32 kB)
This should work on Linux, too. :-) The entire HTTP request header can be customized.
Post Reply