Posting JSON to a restful API with vbscript

Suddenly I found myself in a strange world where I couldn’t just click my heels and escape. A client asked me for a VBScript he could use to post JSON to his restful 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 (at least to my eyes), wow vbscript is strange…. Feel free to steal this and do with it as you please. Hopefuly I just saved you sometime searching.

Please take note on how escaping works in vbscript as this took me sometime to figure out. I’ve tried to make it a bit more readable by creating the QU() function.

' 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"
  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", "2017-01-13 21:30"

Suggestions, tips or flames? Please leave a comment. ♯restful ♯vbscript ♯cscript ♯microsoft ♯development ♯coding ♯scripting ♯json ♯http