<!ELEMENT Customer           (ContactInfo)>
<!ELEMENT ContactInfo        (Address,FirstName,LastName,email)>
<!ELEMENT Address            (Street,City,ProvinceOrState,Code,Country)>
<!ELEMENT FirstName          (#PCDATA) >
<!ELEMENT LastName           (#PCDATA) >
<!ELEMENT email              (#PCDATA) >
<!ELEMENT Street             (#PCDATA) >
<!ELEMENT City               (#PCDATA) >
<!ELEMENT ProvinceOrState    (#PCDATA) >
<!ELEMENT Code               (#PCDATA) >
<!ELEMENT Country            (#PCDATA) >

<Schema xmlns="urn:schemas-microsoft-com:xml-data"
xmlns:dt="urn:schemas-microsoft-com:datatypes">
    <ElementType name='FirstName' content='textOnly'/>
    <ElementType name='LastName' content='textOnly'/>
    <ElementType name='Street' content='textOnly'/>
    <ElementType name='ProvinceOrState' content='textOnly'/>
    <ElementType name='Code' content='textOnly'/>
    <ElementType name='Country' content='textOnly'/>
    <ElementType name='email' content='textOnly'/>

    <ElementType name="Address">
        <element type="Street"/>
        <element type="City"/>
        <element type="ProvinceOrState"/>
        <element type="Code"/>
        <element type ="Country"/>
    </ElementType>

    <ElementType name='ContactInfo'>
        <element type='Address'/>
        <element type='FirstName'/>
        <element type='LastName' />
        <element type='email'/>
    </ElementType>

    <ElementType name='Customer'>
        <element type='ContactInfo'/>
    </ElementType>

</Schema>

Figure 6   AddressChange.htm

<script language="VBScript"><!--
sub Submit()
    dim objXML
    dim strXML
    document.all.message.innerHTML = "Processing..."
    set objXML = GenerateXML()
    SendXML objXML
end sub

function GenerateXML()
    dim objXML
    dim objNode
    dim objElement
    set objXML = CreateObject("Microsoft.XMLDOM")
    set objCustomer = AddXMLNode( objXML, objXML, "Customer", "" )
    set objContactInfo = AddXMLNode( objXML, objXML.firstChild, _
                                     "ContactInfo", "" )
    set objAddress = AddXMLNode( objXML, objContactInfo, "Address", "" )
    AddXMLNode objXML, objAddress, "Street", document.all.street.value
    AddXMLNode objXML, objAddress, "City", document.all.city.value    
    AddXMLNode objXML, objAddress, "ProvinceOrState",_
        document.all.provinceorstate.value    
    AddXMLNode objXML, objAddress, "Code", document.all.code.value    
    AddXMLNode objXML, objAddress, "Country",_
        document.all.country.options(document.all.country.selectedindex).value
    AddXMLNode objXML, objContactInfo, "FirstName", document.all.fName.value    
    AddXMLNode objXML, objContactInfo, "LastName", document.all.lName.value
    AddXMLNode objXML, objContactInfo, "email", document.all.email.value
    objXML.async = false
    if objXML.parseError.errorCode <> 0 Then
        MsgBox "There is an error: " & objXML.parseError.reason
    end if
    set GenerateXML = objXML
end function

function AddXMLNode( DOMXML, Parent, Name, Value )
    dim objNode
    set objNode = DOMXML.createNode( 1, Name, _
                              "x-schema:http://sewan/sample/CustomerSchema.xml" )
    if Len(Value) <> 0 then
        objNode.text = Value
    end if
    Parent.appendChild objNode
    set AddXMLNode = objNode
end function

sub SendXML( XML )
    dim objHttp
    set objHttp = CreateObject("Microsoft.XMLHTTP")
    objHttp.Open "POST", "process.asp", False
    objHttp.Send XML
    document.all.message.innerHTML = objHttp.ResponseXML.xml
end sub
--></script>

Figure 8   Process.asp

<%@ Language=VBScript %>
<%
Option Explicit
ProcessRequest()

Public Sub ProcessRequest()
    dim objXML
    dim strGUID
    On Error Resume Next
    set objXML = Server.CreateObject("Microsoft.XMLDOM")
    Response.ContentType = "text/xml"
    objXML.async = False
    objXML.load Request
    if objXML.parseError.errorCode <> 0 Then
        Response.Write "<Error>" & objxml.parseerror.reason & "</Error>"
    else
        SendMessage "Address Change @ " & Now(), objXML.xml
        if Err.number = 0 then 
            Response.Write "<Success>" & Now() & _
                " - Your request was received and will be processed within 30_
                minutes." & strGUID & "</Success>"
        else
            Response.Write "<Error>" & Err.description  & "</Error>"
        end if
    end if
End Sub

Public Sub SendMessage(ByVal Label, ByVal Body)
    Dim msmqInfo
    Dim msmqQue
    Dim msmqMsg
    Dim strDestination

    strDestination = "DIRECT=TCP:192.168.0.1\Distributor"
    Set msmqInfo = Server.CreateObject("MSMQ.MSMQQueueInfo")
    msmqInfo.FormatName = strDestination
    Set msmqQue = msmqInfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)
    Set msmqMsg = Server.CreateObject("MSMQ.MSMQMessage")
    msmqMsg.Label = Label
    msmqMsg.Body = Body
    msmqMsg.Send msmqQue, MQ_SINGLE_MESSAGE 
    msmqQue.Close
End sub
%>

Figure 12   Distributor Source

Public Sub Distribute(ByVal QueueGUID As String)
On Error GoTo eh
    Dim msmqSourceMsg As MSMQMessage
    Dim msmqSourceQue As MSMQQueue
    
    Dim msmqDestMsg As MSMQMessage
    Dim msmqDestQue As MSMQQueue
    Dim strDestQueue As String
    
    Dim msmqInfo As MSMQQueueInfo
    Dim objReg As REGTool5.Registry
    Dim intNumber As Integer
    Dim bResult As Boolean

    Dim mtsOC As MTxAS.ObjectContext
    
    Set mtsOC = GetObjectContext()
    
    ' Open the source queue and get the current message
    ' The queue has to be opened in MTS to be part of the transaction
    Set msmqInfo = CreateObject("MSMQ.MSMQQueueInfo")
    msmqInfo.FormatName = QueueGUID
    Set msmqSourceQue = msmqInfo.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE)
    Set msmqSourceMsg = msmqSourceQue.ReceiveCurrent(, MQ_MTS_TRANSACTION)
      
    ' create the outgoing message
    Set msmqDestMsg = CreateObject("MSMQ.MSMQMessage")
    msmqDestMsg.Body = msmqSourceMsg.Body
    msmqDestMsg.Label = "Distributed: " & Now & " from: " & msmqSourceMsg.Label

    ' Send a message for each DestinationXX in the registry,
    ' where XX is a number starting at 1
    intNumber = 1
    Set msmqInfo = CreateObject("MSMQ.MSMQQueueInfo")
    Set objReg = CreateObject("REGTool5.Registry")
    bResult = objReg.GetKeyValue(REGToolRootTypes.HKEY_LOCAL_MACHINE, _
                                 "SOFTWARE\Distributor\AddressChange", _
                                 "Destination" & intNumber, strDestQueue)
    While bResult
        ' Open the destination queue using the formatname from the registry
        msmqInfo.FormatName = strDestQueue
        Set msmqDestQue = msmqInfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)
        msmqDestMsg.Send msmqDestQue, MQ_MTS_TRANSACTION
        msmqDestQue.Close
        Set msmqDestQue = Nothing
        
        ' Read the next destination
        intNumber = intNumber + 1
        bResult = objReg.GetKeyValue(REGToolRootTypes.HKEY_LOCAL_MACHINE, _
                                     "SOFTWARE\Distributor\AddressChange", _
                                     "Destination" & intNumber, strDestQueue)
    Wend
    
    msmqSourceQue.Close
    
    mtsOC.SetComplete           ' success: complete the transaction
    Exit Sub
eh:
    mtsOC.SetAbort              ' abort the transaction
    Set msmqDestMsg = Nothing
    Set msmqInfo = Nothing
    App.LogEvent "Source: " & Err.Source & "Description: " & Err.Description & _
                 "Destination Queue: " & strDestQueue, _
                 vbLogEventTypeError Err.Raise vbObjectError + 500, _
                 "Distributor.Distribute", Err.Description
End Sub

Figure 13   Lines of Code

Location	Method	Lines
AddressChange.htm	Submit	3
	GenerateXML	17
	AddXMLNode	6
	SendXML	4
Subtotal		30
Process.asp	ProcessRequest	14
	SendMessage	9
Subtotal		23
Distributor	Distribute	30
Subtotal		30
Listener	CmdStartListening_Click	12
	MsmqMsgEvent_Arrived	9
Subtotal		21
Total Lines of Code		104

Figure 14:   The Third Generation via BizTalk