Last Updated: February 25, 2016

Unlikely coding a VBScript posting to a rest api

Suddenly I found myself in an old world where I couldn't just click my heels and escape. A client asked me for a VBScript he could run which would post JSON to his rest api. I told him I never wrote a line of code for the Windows platform but that I would have it done in an hour or two. Well I did it, and it's not pretty but I don't think that's really my fault, wow this language is, odd.... So if you ever find yourself in a similar situation feel free to steal this and do with it as you wish. It will probably save you a lot of Googling around.

' Script is designed to be run with cscript.exe

Public Function ffPostJSON (uri, some_name, photog, shot_at)
 Set fso = CreateObject ("Scripting.FileSystemObject")
 Set stdout = fso.GetStandardStream (1)
 Set stderr = fso.GetStandardStream (2)

 Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
 URL = "http://some.uri/api/v1/photos"
 objHTTP.Open "POST", URL, False
 objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
 objHTTP.setRequestHeader "Authorization", "Basic base64encodeduserandpassword"
 objHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
 objHTTP.setRequestHeader "CharSet", "charset=UTF-8"
 objHTTP.setRequestHeader "Accept", "application/json"

 ' Send the json in correct format
 json = "{" & Qu("photo") & ": {" & Qu("uri") & ": " & Qu(uri) & ", " &_
 Qu("some_name") & ": " & Qu(some_name) & ", " &_
 Qu("photographer") & ": " & Qu(photog) & "}}"
 objHTTP.send (json)

 ' Output error message to std-error and happy message to std-out. Should
 ' simplify error checking
 If objHTTP.Status >= 400 And objHTTP.Status <= 599 Then
 stderr.WriteLine "Error Occurred : " & objHTTP.status & " - " & objHTTP.statusText
 ffPostJSON = false
 Else
 stdout.WriteLine "Success : " & objHTTP.status & " - " & objHTTP.ResponseText
 ffPostJSON = true
 End If
End Function

' Make escaping a bit more readable :-S
Public Function Qu(ByVal s)
 Qu = Null
 If (VarType(s) = vbString) Then
 Qu = Chr(34) & CStr(s) & Chr(34)
 End If
End Function

' Just here as reference. Function can properly URLencode
Function URLEncode(ByVal Data, CharSet)
 'Create a ByteArray object
 Dim ByteArray: Set ByteArray = CreateObject("ScriptUtils.ByteArray")
 If Len(CharSet)>0 Then ByteArray.CharSet = CharSet

 ByteArray.String = Data

 If ByteArray.Length > 0 Then
 Dim I, C, Out

 For I = 1 To ByteArray.Length
 'For each byte of the encoded data
 C = ByteArray(I)
 If C = 32 Then 'convert space to +
 Out = Out + "+"
 ElseIf (C < 48 Or c>126) Or (c>56 And c<=64) Then
 Out = Out + "%" + Hex(C)
 Else
 Out = Out + Chr(c)
 End If
 Next
 URLEncode = Out
 End If
End Function

' EXAMPLE CALL
ffPostJSON "http://some.url/image.jpg", "somedata", "someperson", "2014-10-13 21:30:00"

#http