UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> 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.

Contents

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.

CODE

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.

CODE

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


Creative Commons License
Asynchronous HTTP Request Class by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 10,032 times.  This page was last modified 15:50, 2 September 2013 by Ace.   Disclaimers