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"
Written by Thomas Cremers
Related protips
Have a fresh tip? Share with Coderwall community!
Post
Post a tip
Best
#Http
Authors
Sponsored by #native_company# — Learn More
#native_title#
#native_desc#