Querying a web service with vbscript (Base64Encode password)

There are lots of different ways that web services and application programming interfaces (api's) work. So we keep copies of the various formats and approaches we have run into over the years.

This example uses an API that had 2 twists:

a) you had to pass it your password that had been base64encoded (so we had to use a special vb function)

b) the api returns a JSON text string

CODE BEGINS:

'Declare variables

Dim strURL, strURL2

Dim objXML, objXML2

Dim strUser

Dim strPassword

strUser="myuserid"

strPassword="mypassword"

Dim strResponse

Dim strResponseline

Dim strOrder

strURL = "https://urlofapi/v1/admin/orders.json?status=P"

Set objXML = CreateObject("MSXML2.XMLHTTP")

objXML.Open "GET", strURL, False, strUser, strPassword

'Note: see custom Base64encode function at bottom of this script

objXML.setRequestHeader "Authorization","Basic " + Base64encode("mypassword")

objXML.send

'This call to their api returns a JSON text string. Let's parse it.

strResponse = objxml.responsetext

'We are splitting the response into multiple lines of text so we can parse it one order at a time

Dim strSplit

'chr(34) is the vbscript code for a double quote

strSplit="{" & chr(34) & "id" & chr(34) & ":" & chr(34)

'This tells us how many lines of text we are going to have when we parse it

Dim count

count = ubound(split(objxml.responsetext, strSplit))

'Now let's cycle through the split lines one by one

for i=1 to count

strResponseline = split(objxml.responsetext, strSplit)(i)

'Split each response line into multiple fields using double quotes

'The first field when you split a text field with the split command always has an index of 0.

'The order id that we need to grab happens to be the first field.

strOrder = split(strResponseline, chr(34))(0)

Next

msgbox "Done"

'FUNCTION TO BASE64Encode password

Function Base64Encode(inData)

'ripped from:

'http://www.pstruh.cz/tips/detpg_Base64Encode.htm

'rfc1521

'2001 Antonin Foller, PSTRUH Software, http://pstruh.cz

Const Base64 = _

"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Dim sOut, I

'For each group of 3 bytes

For I = 1 To Len(inData) Step 3

Dim nGroup, pOut

'Create one long from this 3 bytes.

nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _

&H100 * MyASC(Mid(inData, I + 1, 1)) + _

MyASC(Mid(inData, I + 2, 1))

'Oct splits the long To 8 groups with 3 bits

nGroup = Oct(nGroup)

'Add leading zeros

nGroup = String(8 - Len(nGroup), "0") & nGroup

'Convert To base64

pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _

Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _

Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _

Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)

'Add the part To OutPut string

sOut = sOut + pOut

Next

Select Case Len(inData) Mod 3

Case 1: '8 bit final

sOut = Left(sOut, Len(sOut) - 2) + "=="

Case 2: '16 bit final

sOut = Left(sOut, Len(sOut) - 1) + "="

End Select

Base64Encode = sOut

End Function

Function MyASC(OneChar)

If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)

End Function