2454393a1d
Instead of having multiple locations with the same code, the web interface code now lives in its own module, and is called from multiple locations.
67 lines
1.7 KiB
QBasic
67 lines
1.7 KiB
QBasic
Attribute VB_Name = "HttpHandler"
|
|
Option Explicit
|
|
|
|
Function makeHttpRequest(method As String, route As String, doc As String, ByRef errorMsg As String) As Object
|
|
Dim req As New WinHttp.WinHttpRequest
|
|
Dim json As Object
|
|
Dim wr As String
|
|
Dim res() As Variant
|
|
|
|
On Error GoTo errHandler
|
|
|
|
Set makeHttpRequest = Nothing
|
|
|
|
If doc = "" Then
|
|
errorMsg = "No message to send to the server."
|
|
Exit Function
|
|
End If
|
|
|
|
Dim server As String
|
|
server = shConfig.Range("server").Value
|
|
|
|
With req
|
|
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
|
.Open method, server & "/" & route, True
|
|
.SetRequestHeader "Content-Type", "application/json"
|
|
.Send doc
|
|
Debug.Print method & " /" & route & " (";
|
|
Dim t As Single
|
|
t = Timer
|
|
.WaitForResponse
|
|
wr = .ResponseText
|
|
Debug.Print Timer - t; "sec): "; Left(wr, 200)
|
|
End With
|
|
|
|
If Mid(wr, 1, 1) <> "{" Or _
|
|
Mid(wr, 2, 5) = "error" Or _
|
|
Mid(wr, 1, 6) = "<body>" Or _
|
|
Mid(wr, 1, 6) = "<!DOCT" _
|
|
Then
|
|
errorMsg = "Unexpected Result from Server: " & wr
|
|
Exit Function
|
|
End If
|
|
|
|
If Mid(wr, 1, 6) = "null" Then
|
|
errorMsg = "API route not implemented."
|
|
Exit Function
|
|
End If
|
|
|
|
Set json = JsonConverter.ParseJson(wr)
|
|
|
|
If IsNull(json("x")) Then
|
|
errorMsg = "Empty response from the server."
|
|
Exit Function
|
|
End If
|
|
|
|
Set makeHttpRequest = json
|
|
|
|
exitFunction:
|
|
' Any final clean-up goes here. This will get hit even after errHandler does its thing.
|
|
Exit Function
|
|
|
|
errHandler:
|
|
MsgBox Err.Description
|
|
Resume exitFunction
|
|
End Function
|
|
|