convert CURL request into VBA xml Object in MS-Access - vba

I am trying to handle moodle data from our schools MS-Access database using VBA-code to post xml.objects.
I implemented the following code from an example for using the RESTful-API into my VBA-code (source https://moodle.org/plugins/webservice_restful):
json code:
curl -X POST \
-H "Content-Type: application/json" \
-H "Accept: application/json" \
-H 'Authorization: {token}' \
-d'{"options": {"ids":[6]}}' \
"https://localhost/webservice/restful/server.php/core_course_get_courses"
This is my conversion in VBA in a ms-access db module so far:
Option Compare Database
Option Explicit
Private Sub btnTestMoodleApi_Click()
Dim objRequest As Object
Dim strResult As String
Dim strPostData As String
Dim strToken as String
Dim strURL as String
strToken = xxx
strURL = xxx
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strPostData = "'options[ids][0]=8'"
With objRequest
.Open "POST", strURL & "/webservice/restful/server.php/core_course_get_courses"
.setRequestHeader "Authorization", strToken
' .setRequestHeader Chr(34) & "Authorization" & Chr(34), Chr(34) & EncodeBase64(strToken) & Chr(34) ' is any of this necessary? I also tried single quotes chr(39)
.setRequestHeader "Content-Type", " application/x-www-form-urlencoded"
.setRequestHeader "Accept", "application/json"
.Send (strPostData)
While .ReadyState <> 4
DoEvents
Wend
strResult = .responseText
Debug.Print strResult
End With
End Sub
I am not sure if the following function that I found is necessary:
Function EncodeBase64(text As String) As String
Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)
Dim objXML As MSXML2.DOMDocument60
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument60
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function
Either way the return is an error that there was no authorization header in the request {"exception":"moodle_exception","errorcode":"noauthheader","message":"No Authorization header found in request sent to Moodle"}. I guessed it is a formatting problem, so I tried various sorts of quotes around what I guess is the header type declaration ("Authorization") and the token, nothing worked. Also I found this remark by another person under the CURL source:
"The authorization header was stripped by my version of Apache 2, resulting in a noauthheader error. It worked when added this directive:
SetEnvIf Authorization "(.*)" HTTP_AUTHORIZATION=$1"
However I would not know if that error source applies to my case and how I would implement the directive in my VBA code. Any help would be very much appreciated! By the way this is the corresponding php code in a locallib.php file where I believe the curl request to be directed to:
* Get the webservice authorization token from the request.
* Throws error and notifies caller on failure.
*
* #param array $headers The extracted HTTP headers.
* #return string $wstoken The extracted webservice authorization token.
*/
private function get_wstoken($headers) {
$wstoken = '';
if (isset($headers['HTTP_AUTHORIZATION'])) {
$wstoken = $headers['HTTP_AUTHORIZATION'];
} else {
// Raise an error if auth header not supplied.
$ex = new \moodle_exception('noauthheader', 'webservice_restful', '');
$this->send_error($ex, 401);
}
return $wstoken;
}

Related

How to POST using -x in VBA HTTP API

I have a bunch of API calls to STRIPE which are working well.
Generally I use the cURL version and work out what I need to do.
I have just come across the need to DELETE a subscription:
curl https://api.stripe.com/v1/subscriptions/sub_FpZkRarex4obNX \
-u sk_test_VHkTM0bOtpsE1dBnTxFbMBAk00WnBQnyI5: \
-X DELETE
The issue is I have no idea how to use the -x in VBA
My current code for other calls is:
api_Key = getStripeAPI
req = "DELETE"
Set httpReq = CreateObject("MSXML2.ServerXMLHTTP")
httpReq.Open "POST", "https://api.stripe.com/v1/subscriptions/" & stripeSubID, False
httpReq.setRequestHeader "Authorization", "Bearer " & api_Key
httpReq.send req
strResponse = httpReq.responseText
Debug.Print strResponse
writeToText strResponse
Set parsed = JsonConverter.ParseJson(strResponse)
I know the above code is incorrect but if someone can let me know how to utilise -X that would be great.
You're already using it, just passing the wrong argument. It's the first argument to .Open:
httpReq.Open "DELETE", "https://api.stripe.com/v1/subscriptions/" & stripeSubID, False
ok wow i just figured it by myself.. after 45 mins of trying.
For those looking fr this:
-x DELETE means use DELETE as the "GET"/"POST" option.
working code:
api_Key = getStripeAPI
Set httpReq = CreateObject("MSXML2.ServerXMLHTTP")
httpReq.Open "DELETE", "https://api.stripe.com/v1/subscriptions/" & stripeSubID, False
httpReq.setRequestHeader "Authorization", "Bearer " & api_Key
httpReq.send
strResponse = httpReq.responseText
Debug.Print strResponse
writeToText strResponse
Set parsed = JsonConverter.ParseJson(strResponse)

REST API access via VBA returns "Invalid ID/Key" error

I am attempting to access the Appointments-Plus.com API via VBA code and am consistently being told I'm giving it an invalid site-id/key. I'm using Access from the Office365 version.
This is the relevant documentation for this API call.
When I use Postman to test out the API, I am able to successfully connect and I get data back. The URL Postman puts together is this:
https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<site-ID>:<Key>&response_type=xml
My VBA code is this:
Public Sub RESTtestBigURL()
Dim responseType As String
responseType = "response_type=json"
Dim restRequest As WinHttp.WinHttpRequest
Set restRequest = New WinHttp.WinHttpRequest
Dim restResult As String
With restRequest
.Open "POST", "https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<site-ID>:<Key>&response_type=xml", False
.Send
.WaitForResponse
Debug.Print ".ResponseText: " & .ResponseText
Debug.Print ".Status: " & .Status
Debug.Print ".StatusText: " & .StatusText
Debug.Print ".ResponseBody: " & .ResponseBody
End With
End Sub
I know that the first question is "are you sure you've got the <site-ID> and <key> correct???" Yes - I've copy/pasted the entire URL from Postman into my VBA code, and I've had another couple of pairs of eyeballs review it to confirm that they're still the same.
When I run that code, I get:
.ResponseText: <?xml version="1.0" encoding="utf-8" ?>
<APResponse>
<resource>customers</resource>
<action>getcustomers</action>
<request></request>
<result>fail</result>
<count>0</count>
<errors>
<error><![CDATA[Web Services authentication failed: invalid Site ID or API Key]]></error>
</errors>
</APResponse>
I've tried several other methods of accessing the API, all of which are giving me the same "Invalid ID/Key" error:
Public Sub SecondRESTtestMSXML()
Dim restRequest As MSXML2.XMLHTTP60
Set restRequest = New MSXML2.XMLHTTP60
With restRequest
.Open "GET", URL & REQUEST_GET_LOCATIONS, True
.SetRequestHeader "Authorization", "Basic" & SITE_ID & ":" & API_KEY
.SetRequestHeader "response_type", "xml"
.SetRequestHeader "Accept-Encoding", "application/xml"
.Send "{""response_type"":""JSON""&""location"":""582""}"
While .ReadyState <> 4
DoEvents
Wend
Debug.Print ".ResponseText: " & .ResponseText
Debug.Print ".Status: " & .Status
Debug.Print ".StatusText: " & .StatusText
Debug.Print ".ResponseBody: " & .ResponseBody
End With
End Sub
There is a suggestion that this is a duplicate of another question that was resolved by Base64-encoding. However, this method, while it wasn't explicit, shows that I have attempted that, too. I've added the Base64Encode function code that is called from here.
Public Sub RESTtest()
Dim restRequest As WinHttp.WinHttpRequest
Set restRequest = New WinHttp.WinHttpRequest
Dim restResult As String
With restRequest
.Open "POST", URL & REQUEST_GET_LOCATIONS, True
.SetRequestHeader "Authorization", "Basic " & SITE_ID & ":" & Base64Encode(API_KEY)
' Note call to Base64Encode() on this line ---------------- ----- ^^^^^^^^^^^^
.Option(WinHttpRequestOption_EnableRedirects) = False
.Send "{""response_type"":""JSON""}"
.WaitForResponse
Debug.Print ".ResponseText: " & .ResponseText
Debug.Print ".Status: " & .Status
Debug.Print ".StatusText: " & .StatusText
Debug.Print ".ResponseBody: " & .ResponseBody
End With
End Sub
Public Function Base64Encode(ByVal inputText As String) As String
Dim xmlDoc As Object
Dim docNode As Variant
Set xmlDoc = CreateObject("Msxml2.DOMDocument.3.0")
Set docNode = xmlDoc.createElement("base64")
docNode.DataType = "bin.base64"
docNode.nodeTypedValue = Stream_StringToBinary(inputText)
Base64Encode = docNode.Text
Set docNode = Nothing
Set xmlDoc = Nothing
End Function
Notes:
URL, REQUEST_GET_LOCATIONS, SITE_ID, and API_KEY are constants declared globally in this module for testing purposes. They, too, have all been copy/pasta'd and reviewed by several people for typos.
You may note that there are requests for responses in both XML and JSON - they're both giving me the same response.
I do have a support ticket open with Appt Plus, but I'm hoping I might get a faster response here.
Are there any obvious errors that anyone sees in this code? Are there any suggestions for other methods to attempt to call the API and get results? I've had a suggestion to write a DLL in C# and call that, however, I don't have the time to learn enough C# to make that happen, so switching languages isn't really an option here.
Additional notes:
I tried this using curl in a Powershell session, and it gives me the same result:
PS H:\> curl -method Post -uri "https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<ID>:<key>&response_type=json"
The result:
StatusCode : 200
StatusDescription : OK
Content : {"resource":"locations",
"action":"getlocations",
"request":"",
"result":"fail",
"count":"0"
,"errors":[
"Web Services authentication failed: invalid Site ID or API ...
RawContent : HTTP/1.1 200 OK
Pragma: no-cache
Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
Date: Mon, 26 Aug 2019 17:28:41 GMT
Expires: Thu, 19 Nov 1981 08:52:00 GMT
Set-Cooki...
Forms : {}
Headers : {[Pragma, no-cache], [Cache-Control, no-store, no-cache, must-revalidate, post-check=0,
pre-check=0], [Date, Mon, 26 Aug 2019 17:28:41 GMT], [Expires, Thu, 19 Nov 1981 08:52:00 GMT]...}
Images : {}
InputFields : {}
Links : {}
ParsedHtml : mshtml.HTMLDocumentClass
RawContentLength : 207
Per the exchanges in the comments, the main issue appears to be how the basic authorization header was being formed.
For future readers, the format for the authorization header is:
.SetRequestHeader "Authorization", "Basic " & Base64Encode(SITE_ID & ":" & API_KEY)
Also, another issue you may run into is related here. Linebreaks are inserted into the Base64 encoded string with the current approach, which won't play nice with most (if not all) APIs. A suggested fix for this would be something like:
Public Function Base64Encode(ByVal inputText As String, Optional removeBlankLines = True) As String
Dim xmlDoc As Object
Dim docNode As Variant
Set xmlDoc = CreateObject("Msxml2.DOMDocument.3.0")
Set docNode = xmlDoc.createElement("base64")
docNode.DataType = "bin.base64"
docNode.nodeTypedValue = Stream_StringToBinary(inputText)
Base64Encode = docNode.Text
Set docNode = Nothing
Set xmlDoc = Nothing
'remove blank line characters ASCII --> 10,13,10 + 13
If removeBlankLines Then Base64Encode = Replace(Replace(Replace(Base64Encode, vbCrLf, vbNullString), vbLf, vbNullString), vbCr, vbNullString)
End Function

How to pass API key in VBA for Get and Post Request?

I am using https://developer.companieshouse.gov.uk/api/docs/ to access an API
I have my API key, however, i am not sure how to pass that from VBA. So far i tried below
AuthKey = [Key received]
With CreateObject("Microsoft.XMLHTTP")
.Open "GET", strUrl, False, authKey
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Accept", "application/json"
.SetRequestHeader "Authorization", "Basic " & AuthKey
.Send
response = .ResponseText
End With
When i try from their test page https://developer.companieshouse.gov.uk/document/docs/document/id/content/fetchDocument.html it works well and when i goto dev tools that Authorization key is different, i think i am missing some encoding. Can someone please help
Thanks
Basic auth requires the username and password to be base 64 encoded together. The AuthKey you need to pass is essentially:
def unencoded_auth = "[username]:[authkey]"
def encoded_auth = *call-to-base64-encode-value*(unencoded_auth)
Then you would replace
"Basic " & AuthKey
with
"Basic " & encoded_auth
I'll reference this post as to how to achieve the base64 encoding.
I found it.. i was missing to encode the key
Function EncodeBase64(text As String) As String
Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function

"LOADING" SOAP response to DOMDocument

After some help from stackoverflow experts I have been able to successfully retrieve my response using SOAP. The below piece is how I received and stored the data. This of course is not all the code. I just included this to show how I later reference the xml.
With xmlhtp
webserviceSOAPActionNameSpace = "http://example.com/webservices/"
.Open "POST", sUrl, False
.setRequestHeader "POST", "https://onesite.example.com/webservices/stuff.asmx HTTP/1.1"
.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
.setRequestHeader "Content-Length", 100
.setRequestHeader "SOAPAction", webserviceSOAPActionNameSpace & "RetrieveData"
.send sEnv
sResult = xmlhtp.statusText
responseText = xmlhtp.responseText
ActiveSheet.Cells(1, 1).Value = .responseText
End With
Debug.Print responseText
Now I am having trouble parsing that out. This seems like it should be pretty simple but I get an error indicating that the responseText I receive above is not "loading" to xmlDOC. The following is at the beginning of the sub:
Dim xmlhtp As New MSXML2.XMLHTTP
Dim xmlDoc As New DOMDocument
Dim XDoc As Object
After the With End (shown above) my code looks like this:
Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False
XDoc.Load (xmlhtp.responseText)
Set lists = XDoc.DocumentElement
Set getFirstChild = lists.FirstChild
Debug.Print getFirstChild.XML
Debug.Print getFirstChild.Text
On the line
Set getFirstChild = lists.FirstChild
I recieve the following error
Object variable or With block variable not set
When I look at the Local Variable window in VBA I can clearly see that nothing was assigned to xmlDoc. So I assume my problem is in XDoc.Load Line.
Any direction would be appreciated.
use XDoc.LoadXML (xmlhtp.responseText) instead of XDoc.Load (xmlhtp.responseText)

Exchanging Authorization Code for Access Token for Google Calendar API with VBA and Oauth2

After successfully obtaining the authorization code, I am having trouble exchanging it for an access token and refresh token while trying to access the Google Calendar API. I get Error 404 Not Found. Here is my code:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/auth2/token"
Dim getTokenBody As String
getTokenBody = "code=" & code & _
"&redirect_uri=urn:ietf:wg:oauth:2.0:oob" & _
"&client_id=xxxxxxx-xxxxxxxx.apps.googleusercontent.com" & _
"&client_secret={myLittleSecret}" & _
"&grant_type=authorization_code"
Dim Http As MSXML2.XMLHTTP60
Set Http = CreateObject("MSXML2.XMLHTTP.6.0")
With Http
.Open "POST", getTokenUrl, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send(getTokenBody)
End With
Do While Http.ReadyState <> 4
Loop
Debug.Print Http.responseText
I have also tried putting everything in the url parameter of the .Open method and nothing in the .Send method:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/oauth2/token&code=" & code & "&client_id=xxxxxx-xxxxxx.apps.googleusercontent.com&client_secret={myLittleSecret}&redirect_uri=urn:ietf:wg:oauth:2.0:oob&grant_type=authorization_code"
Dim Http As MSXML2.XMLHTTP60
Set Http = CreateObject("MSXML2.XMLHTTP.6.0")
With Http
.Open "POST", getTokenUrl, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send("")
End With
I have tried using WinHttp.WinHttpRequest instead of MSXML2.XMLHTTP.
I have tried using http://localhost instead of urn:ietf:wg:oauth:2.0:oob.
I have tried making http://localhost and urn:ietf:wg:oauth:2.0:oob url encoded.
All give Error 404 Not Found.
Can someone help point me in the right direction?
Finally figured it out--
The URL I was using was wrong--a one-letter type-o /forehead-slap/
instead of:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/auth2/token"
it should have been:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/oauth2/token"
note the oauth2 instead of just auth2
Geesh. Sometimes I just need more sleep.
Incidentally, I could only get it to work when I put only the base URL in the .Open request and the parameters in the .send() (rather than stringing them all together in to one URL and "POST"ing it).
Working like a charm now!