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 |
VBScripting >