Tutorials » Creating a Web Service using ActiveX Components

SOAP Server

To create the SOAP server we will need the following

• An ActiveX Server Component.
  
  • In this example we will create a Visual Basic 6.0 dll.
    
• An Active Server Page (ASP) to act as a "listener".
  
  • This listener will handle our incoming SOAP messages and pass the request to our SOAP Server object.

ActiveX Server Component

1. Open Visual Studio 6.0
   
2. Create a new ActiveX dll Project
   
3. Change the name of your project to SoapServer
   
4. Change the name of your class to MathFunctions
   
5. Add references to the SOAP Type Library* and Active Server Pages Object Library

* For this example, I use SOAP Type Library v3.0.

Code for MathFunctions.cls

The SOAP server will accept incoming SOAP messages. The messages will be passed from our ASP listener page via the request. The SOAP server will parse out the method call and parameters using a SOAP Reader object. The server then determines operation, executes and returns a SOAP response.

Option Explicit

Public Sub Load(ByVal RequestIn As ASPTypeLibrary.Request, _
      ByVal ResponseOut As ASPTypeLibrary.Response)

Dim SOAPReader As MSSOAPLib30.SOAPReader30
Dim SOAPSerializer As MSSOAPLib30.SOAPSerializer30
Dim SOAPResult As Long
Dim RpcParameter As Long
Dim SOAPMethodCall As String

' Initialize SOAP Reader

Set SOAPReader = New MSSOAPLib30.SOAPReader30

' Load Request

SOAPReader.Load RequestIn

' Get Operation Name
SOAPMethodCall = SOAPReader.RpcStruct.baseName

' Get Parameter Value
RpcParameter = SOAPReader.RpcParameter("Number", "uri:Math").Text

' Decide Action
Select Case SOAPMethodCall

    Case "CalcSquareRoot"
         SOAPResult = CalcSquareRoot(RpcParameter)
         If (SOAPResult <> -1) Then
             SendResponse ResponseOut, SOAPResult
         Else
             SendFault ResponseOut, "Client", "Invalid Input. Cannot Take " & _
                 "The Square Root Of A Negative Number"
         End If

    Case "CalcFactorial"
         SendResponse ResponseOut, CalcFactorial(RpcParameter)

    Case Else
         SendFault ResponseOut, "Client", "Invalid Method Call."

End Select

End Sub

' Calculate Factorial
Private Function CalcFactorial(ByVal num As Long) As Long
    If num <= 1 Then
        CalcFactorial = 1
    Else
        CalcFactorial = num * CalcFactorial(num - 1)
    End If
End Function

' Calculate Square Root
Private Function CalcSquareRoot(ByVal num As Long) As Long
    If num < 0 Then
        CalcSquareRoot = -1
    Else
        CalcSquareRoot = Sqr(num)
    End If
End Function

' Build and Send Response

Private Sub SendResponse(ByVal ResponseOut As ASPTypeLibrary.Response, _
        ByVal answer As Long, ByVal SOAPMethodCall As String)

    Dim SOAPSerializer As MSSOAPLib30.SOAPSerializer30

    Set SOAPSerializer = New MSSOAPLib30.SOAPSerializer30
    ResponseOut.ContentType = "text/xml"
    SOAPSerializer.Init ResponseOut

    ' Build SOAP Envelope

    SOAPSerializer.StartEnvelope
      SOAPSerializer.StartBody
        SOAPSerializer.StartElement SOAPMethodCall & "Response", "uri:Math", , _
                "Functions"
          SOAPSerializer.StartElement "Answer", "uri:Math", , "Functions"
            SOAPSerializer.WriteString answer
          SOAPSerializer.EndElement
        SOAPSerializer.EndElement
      SOAPSerializer.EndBody
    SOAPSerializer.EndEnvelope

End Sub

' On Error Build and Send SOAP Fault

Private Sub SendFault(ByVal ResponseOut As ASPTypeLibrary.Response, _
         ByVal FaultCode As String, ByVal FaultString As String)

    Dim SOAPSerializer As MSSOAPLib30.SOAPSerializer30

    Set SOAPSerializer = New MSSOAPLib30.SOAPSerializer30
    ResponseOut.ContentType = "text/xml"
    SOAPSerializer.Init ResponseOut

    SOAPSerializer.StartEnvelope
      SOAPSerializer.StartBody
        SOAPSerializer.StartFault FaultCode, FaultString
          SOAPSerializer.StartFaultDetail
          SOAPSerializer.EndFaultDetail
        SOAPSerializer.EndFault
      SOAPSerializer.EndBody
    SOAPSerializer.EndEnvelope

End Sub