Set XML API Headers [duplicate] - asp-classic

Question

I have a page that calls an api that in test mode has not required any authorization.
We are now moving to a live environment where a username and password will be required.
The api provider has sent the following message:
To access these services please send the requests by adding following HTTP header.
Authorization: Basic Base64Encode(“username: password”)
I'm not sure of the correct syntax and wondered if someone could help me out.
The original call (and working perfectly) is:
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.DOMDocument.3.0")
xmlobj.async = false
xmlobj.setProperty "ServerHTTPRequest", True
xmlObj.AddHeader "Authorization", "Basic", Base64Encode(username & ":" & password)
xmlobj.load(sUrl)
The above code throws an error
/api-test.asp |20|800a000d|Type_mismatch:_'Base64Encode'
Any help would be greatly appreciated.

Answer 1

Like I've mentioned in the comments, the syntax for the Authorization header is incorrect.
The API example doesn't expect "Base64Encode('username','password')" this is an example supplied by the API to show you how to take the string "username:password" and Base64 encode it which is what the Authorization header is expecting.
But you still need to have the Base64Encode() function definition for the code to work.
Base64Encode() and MyASC() functions are taken from Base64 encode VBS function (vb encoder algorithm), source code
Something like this should work;
<%
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'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
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
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
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.XMLHTTP.3.0")
xmlobj.Open "GET", sUrl, False
xmlobj.setRequestHeader "Authorization", "Basic " & Base64Encode(username & ":" & password)
xmlobj.Send
Dim xmldoc
If xmlobj.status = 200 Then
Set xmldoc = Server.CreateObject("MSXML2.DOMDocument.3.0")
xmldoc.Load xmlobj.ResponseXML
Else
Response.Write "An error occurred!"
End If
%>