5b1333b8c1
This is to help the user know where a functioning workbook (the one they're currently in) needs to be located to continue working.
84 lines
2.7 KiB
QBasic
84 lines
2.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
|
|
|
|
' Inject the user's name and the current version of this file into the request body.
|
|
Set json = JsonConverter.ParseJson(doc)
|
|
json("version") = shConfig.Range("version").value
|
|
json("username") = Application.UserName
|
|
doc = JsonConverter.ConvertToJson(json)
|
|
|
|
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
|
|
|
|
' This is a poor man's self-upgrade mechanism for this application.
|
|
If Mid(wr, 1, 24) = "Obsolete client workbook" Then
|
|
If MsgBox("Your workbook is an older version and needs to be upgraded. Download now? This workbook will be closed so your download can overwrite it. To ease the transition, save the downloaded file in the same location as this one: " & vbCrLf & vbCrLf & ActiveWorkbook.FullName, vbYesNo + vbQuestion) = vbYes Then
|
|
ActiveWorkbook.FollowHyperlink server & "/template"
|
|
ActiveWorkbook.Close False
|
|
Else
|
|
errorMsg = "You won't be able to use this workbook until you upgrade it. Please download the new one the next time you're prompted."
|
|
Exit Function
|
|
End If
|
|
End If
|
|
|
|
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
|
|
|