Asynchronous HTTP Request Class

This class is a wrapper (Facade in the language of design patterns) around the XMLHttp class of the Microsoft XML Core Services (MSXML) library. The purpose of the class is to make an asynchronous HTTP request and receive a response from a VB6/VBA based client.

The OnReadyState Change Event

Each time the ready state of a XMLHttp request is updated the OnReadyStateChange event is raised. In order to respond to this event the OnReadyStateChange property must be set to a function/method. This method is then called when the OnReadyStateChange event is raised. This is what is commonly referred to as a callback function.

Enabling a Callback function in VB6/VBA

On order to enable a method of a custom VB6/VBA class to be set as a callback the method must be the default method of the class. A method is made the default by setting the value of it’s VB_UserMemId attribute equal to 0. Setting attributes of a class or method is not supported in the VBA IDE as it is in the VB6 IDE. With VBA, attribute directives can be added to a plain text .cls file which is then imported into the VBA IDE.

Setting the OnReadyStateChange property

Once the default method of a class has been defined the XMLHTTP object’s OnReadyStateChange property can be set to an instance of the class. When the OnReadyStateChange change event is fired the default method is called.

m_oXmlHttp.onreadystatechange = Me

The Code

Client Code Example

The client in this example is an Access form. It could just as well be another custom class.
The important thing to take away from the example is declaring the clsAsyncHTTP with events and implementing the ResponseReady method of the class.

Option Compare Database
Option Explicit

Private m_ServiceURL As String
Private WithEvents oAH As clsAsyncHTTP

Private Sub Form_Open(Cancel As Integer)
'this is a web service that returns word definitions from several sources
m_ServiceURL = "http://services.aonaware.com/DictService/DictService.asmx/"
End Sub

Private Sub oAH_ResponseReady(ByVal ready As Boolean)
If ready Then
With oAH
'text box controls
Me.txtResponseText = .GetReponseText
Me.txtResponseXML = .GetReponseXML
Me.txtHeaders = .GetHeaders
Me.txtStatus = .StatusCode
End With
End If
End Sub

Private Sub cmdSend_Click()
'command button control
Call PerformSearch
End Sub

Private Sub PerformSearch()
On Error GoTo errHandler

Me.txtResponseText = ""
Me.txtResponseXML = ""
Me.txtStatus = ""

If Len(m_ServiceURL) = 0 Then
MsgBox "The Service URL has not been set.", , "Service URL Error"

ElseIf IsNull(Me.txtTargetWord.Value) Then
MsgBox "You didn't enter a search term.", , "User Error"
Else
Set oAH = New clsAsyncHTTP
oAH.GetRequest m_ServiceURL, "Define?word=" & Me.txtTargetWord.Value
End If

exitHere:
On Error GoTo 0
Exit Sub

errHandler:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure PerformSearch of VBA Document Form_frmAsyncHttp"
Resume exitHere
End Sub

Private Sub Form_Close()
Set oAH = Nothing
End Sub

The AsyncHTTP Class

The following code should be copied and pasted into a text editor and saved with a .cls extension.
The .cls file would then be imported via the VBA IDE.

VERSION 1.0 CLASS
BEGIN
MultiUse = -1  'True
END
Attribute VB_Name = "clsAsyncHTTP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

'---------------------------------------------------------------------------------------
' Module    : clsAsyncHTTP
' Author    : rick cooney (ace)
' Date      : 9/1/2013
' Purpose   : Make an asynchronous HTTP request to a URL
'             and receive a response
'---------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

Const READYSTATE_COMPLETE = 4

Private m_oXmlHttp As MSXML2.XMLHTTP
Private m_ServiceURL As String
Private m_responseText As String
Private m_responseXML As String

Public Event ResponseReady(ByVal ready As Boolean)

Public Sub HandleResponse()
Attribute HandleResponse.VB_UserMemId = 0
'---default method---
If m_oXmlHttp.readyState = READYSTATE_COMPLETE Then
RaiseEvent ResponseReady(True)
End If
End Sub

Public Property Let serviceURL(url As String)
m_ServiceURL = url
End Property

Public Function GetHeaders() As String
GetHeaders = m_oXmlHttp.getAllResponseHeaders
End Function

Public Function GetReponseText() As String
GetReponseText = m_oXmlHttp.responseText
End Function

Public Function GetReponseXML() As String

On Error GoTo errHandler

GetReponseXML = m_oXmlHttp.responseXML

exitHere:
On Error GoTo 0
Exit Function

errHandler:

GetReponseXML = "Error " & Err.Number & " (" & Err.Description & ") in procedure GetReponseXML of Class Module clsAsyncHTTP"
Resume exitHere
End Function

Public Property Get StatusCode() As String
StatusCode = m_oXmlHttp.statusText
End Property

Public Property Get HasServiceURL() As Boolean
HasServiceURL = Len(m_ServiceURL) > 0
End Property

Public Sub GetRequest(Optional serviceURL As Variant, Optional action As Variant)
'errors need to be handled in the calling code of the client
Dim thisRequest As String

'Example:

'serviceURL: "http://services.aonaware.com/DictService/DictService.asmx/"
'    action: "Define?word="

If IsMissing(action) Then
action = ""
End If

If Not IsMissing(serviceURL) Then
m_ServiceURL = serviceURL
End If

If m_ServiceURL = "" Then
Err.Raise vbObjectError + 1001, "clsAsyncHTTP.GetRequest()", "The Service URL has not been set"
End If

thisRequest = m_ServiceURL & action

Set m_oXmlHttp = New MSXML2.XMLHTTP

m_oXmlHttp.Open "GET", thisRequest, True
m_oXmlHttp.setRequestHeader "Content-Type", "text/html"

'this sets the onreadystatechange call back to an instance of this object
'which causes the default method HandleResponse to be called when the ready
'state changes
m_oXmlHttp.onreadystatechange = Me
m_oXmlHttp.send

End Sub


Private Sub Class_Terminate()
Set m_oXmlHttp = Nothing
End Sub