VBScripting‎ > ‎

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

Comments