ServerXMLHTTP60 WebAPI authentication (special character: &

i try to authenticate on a "private" web-api in MS-Access with ServerXMLHTTP60. It works fine until i try to use a the special character "&".

Here is the example:

Private m_xml_auth As MSXML2.ServerXMLHTTP60

Private Function do_connect() As Boolean
Dim json_obj As Object
Dim credential_str As String

If m_password = "" Then
    do_connect = False
    Exit Function
End If

credential_str = "grant_type=password&username=" & m_username & "&password=" _
                   & m_password & "&client_id=" & m_client_id & "&client_secret=" & m_client_secret & ""


m_xml_auth.Open bstrMethod:="POST", bstrURL:=m_auth_url, varAsync:=False
m_xml_auth.setRequestHeader bstrheader:="Content-Type", bstrValue:="application/x-www-form-urlencoded"
m_xml_auth.send (credential_str)

If m_xml_auth.Status <> 200 Then
    do_connect = False
    m_password = ""
    MsgBox "Error while authentication: " & m_xml_auth.responseText
    
    'Err.Raise Number:=M_ERR_API_RESPONSE, _
        'DESCRIPTION:="Authentication failed - response-status: " & m_xml_auth.Status
        
Else
    Set json_obj = JsonConverter.ParseJson(m_xml_auth.responseText)
    m_bearer_token = "Bearer " & json_obj("access_token")

    Debug.Print m_bearer_token
    do_connect = True
End If
End Function

If there is a "&" in one of my variables -> for example in m_password the authentication fails. Is there a way to escape the special character "&" for "x-www-form-urlencoded" content-type?

Thanks, Mr. Dev

CodePudding user response：

Run each String through this function:

Public Function URLEncode( _
   ByVal StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String
  Dim bytes() As Byte, b As Byte, i As Integer, space As String

  If SpaceAsPlus Then space = " " Else space = " "

  If Len(StringVal) > 0 Then
    With New ADODB.Stream
      .Mode = adModeReadWrite
      .Type = adTypeText
      .Charset = "UTF-8"
      .Open
      .WriteText StringVal
      .Position = 0
      .Type = adTypeBinary
      .Position = 3 ' skip BOM
      bytes = .Read
    End With

    ReDim result(UBound(bytes)) As String

    For i = UBound(bytes) To 0 Step -1
      b = bytes(i)
      Select Case b
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Chr(b)
        Case 32
          result(i) = space
        Case 0 To 15
          result(i) = "%0" & Hex(b)
        Case Else
          result(i) = "%" & Hex(b)
      End Select
    Next i

    URLEncode = Join(result, "")
  End If
End Function