Skip to content

Instantly share code, notes, and snippets.

@timhall

timhall/OPS.bas

Last active July 4, 2016 14:44
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save timhall/0a8863202ffb9129515cf6397abf0ed5 to your computer and use it in GitHub Desktop.
Save timhall/0a8863202ffb9129515cf6397abf0ed5 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
OPS.bas
Private pClient As WebClient
Public Property Get Client() As WebClient
If pClient Is Nothing Then
Set pClient = New WebClient
pClient.BaseUrl = "https://ops.epo.org/3.1/"
' Setup authenticator (note: provide consumer key and secret here
Dim Auth As New OPSAuthenticator
Auth.Setup "CONSUMER_KEY", "CONSUMER_SECRET"
' If there are issues automatically getting the token with consumer key / secret
' the token can be found in the developer console and manually entered here
' Auth.Token = "AUTH_TOKEN"
Set pClient.Authenticator = Auth
' Add XML converter
WebHelpers.RegisterConverter "xml", "application/xml", "OPS.ConvertToXml", "OPS.ParseXml"
End If
Set Client = pClient
End Property
Public Function Search(Query As String) As WebResponse
Dim Request As New WebRequest
Request.Resource = "rest-services/published-data/search"
Request.CustomResponseFormat = "xml"
Request.AddQuerystringParam "q", Query
Set Search = Client.Execute(Request)
End Function
' Enable XML parsing/converting
' https://github.com/VBA-tools/VBA-Web/wiki/XML-Support-in-4.0
Public Function ParseXml(Value As String) As Object
Set ParseXml = CreateObject("MSXML2.DOMDocument")
ParseXml.Async = False
ParseXml.LoadXML Value
End Function
Public Function ConvertToXml(Value As Variant) As String
ConvertToXml = VBA.Trim$(VBA.Replace(Value.Xml, vbCrLf, ""))
End Function
Raw
OPSAuthenticator.cls
''
' OPSAuthenticator v3.0.0
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
'
' OAuth2 client credentials authenticator for OPS
'
' @class OPSAuthenticator
' @implements IWebAuthenticator v4.*
' @author tim.hall.engr@gmail.com
' @license MIT
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
Implements IWebAuthenticator
Option Explicit
Public ConsumerKey As String
Public ConsumerSecret As String
Public Token As String
' ============================================= '
' Public Methods
' ============================================= '
''
' Setup authenticator
''
Public Sub Setup(ConsumerKey As String, ConsumerSecret As String)
Me.ConsumerKey = ConsumerKey
Me.ConsumerSecret = ConsumerSecret
End Sub
''
' Hook for taking action before a request is executed
'
' @param {WebClient} Client The client that is about to execute the request
' @param in|out {WebRequest} Request The request about to be executed
''
Private Sub IWebAuthenticator_BeforeExecute(ByVal Client As WebClient, ByRef Request As WebRequest)
If Me.Token = "" Then
Me.Token = Me.GetToken(Client)
End If
Request.SetHeader "Authorization", "Bearer " & Me.Token
End Sub
''
' Hook for taking action after request has been executed
'
' @param {WebClient} Client The client that executed request
' @param {WebRequest} Request The request that was just executed
' @param in|out {WebResponse} Response to request
''
Private Sub IWebAuthenticator_AfterExecute(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Response As WebResponse)
' e.g. Handle 401 Unauthorized or other issues
End Sub
''
' Hook for updating http before send
'
' @param {WebClient} Client
' @param {WebRequest} Request
' @param in|out {WinHttpRequest} Http
''
Private Sub IWebAuthenticator_PrepareHttp(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Http As Object)
' e.g. Update option, headers, etc.
End Sub
''
' Hook for updating cURL before send
'
' @param {WebClient} Client
' @param {WebRequest} Request
' @param in|out {String} Curl
''
Private Sub IWebAuthenticator_PrepareCurl(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Curl As String)
' e.g. Add flags to cURL
End Sub
Public Function GetToken(Client As WebClient) As String
Dim TokenClient As WebClient
Dim TokenRequest As New WebRequest
Dim Encoded As String
Dim TokenResponse As WebResponse
' Clone client to avoid accidental interactions
Set TokenClient = Client.Clone
Set TokenClient.Authenticator = Nothing
' Setup request according to docs
' http://documents.epo.org/projects/babylon/eponet.nsf/0/7AF8F1D2B36F3056C1257C04002E0AD6/$File/OPS_v3.1_documentation_version_1.2.14_en.pdf
TokenRequest.Resource = "auth/accesstoken"
TokenRequest.RequestFormat = WebFormat.FormUrlEncoded
TokenRequest.ResponseFormat = WebFormat.Json
TokenRequest.Method = WebMethod.HttpPost
' Add encoded consumer key/secret as basic authentication
Encoded = WebHelpers.Base64Encode(Me.ConsumerKey & ":" & Me.ConsumerSecret)
TokenRequest.SetHeader "Authorization", "Basic " & Encoded
' Set grant_type in body
TokenRequest.AddBodyParameter "grant_type", "client_credentials"
Set TokenResponse = TokenClient.Execute(TokenRequest)
If TokenResponse.StatusCode = WebStatusCode.Ok Then
GetToken = TokenResponse.Data("access_token")
Else
WebHelpers.LogError "Failed to load token, " & TokenResponse.StatusCode & ": " & TokenResponse.Content
End If
End Function
Raw
Testing.bas
Sub Test()
WebHelpers.EnableLogging = True
Dim Response As WebResponse
Set Response = OPS.Search("plastic")
If Response.StatusCode <> WebStatusCode.Ok Then
Exit Sub
End If
Debug.Print "Search Results"
Debug.Print "--------------"
Dim Result As Variant
Dim Family As String
Dim DocumentNumber As String
' world-patent-data > biblio-search > search-result > [publication-reference...]
For Each Result In Response.Data.LastChild.LastChild.LastChild.ChildNodes
Family = Result.Attributes(1).NodeValue
DocumentNumber = Result.FirstChild.ChildNodes(1).Text
Debug.Print "Result - " & Family & ", " & DocumentNumber
Next Result
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment