B2B Integration with SAP Infrastructure using Microsoft BizTalk Server.

Private Function IPipelineComponent_Execute_
(ByVal objOrderForm As Object, ByVal objContext As Object,_
 ByVal lFlags As Long) As Long



    On Error GoTo ERROR_Execute



    Dim oXMLTransforms As Object

    Dim oXMLSchema As Object

    Dim oOrderFormXML As Object



    ' Return 1 for Success.

    IPipelineComponent_Execute = 1



    ' Create a DictionaryXMLTransforms object.

    Set oXMLTransforms = CreateObject("Commerce.DictionaryXMLTransforms")



    ' Create a PO schema object.

    Set oXMLSchema = oXMLTransforms.GetXMLFromFile(sSchemaLocation)



    ' Create an XML version of the order form.

    Set oOrderFormXML = _
  oXMLTransforms.GenerateXMLForDictionaryUsingSchema(objOrderForm, oXMLSchema)



    WritePO2MSMQ sQueueName, oOrderFormXML.xml, PO_TO_ERP_QUEUE_LABEL,_
                               sBTSServerName, AFS_PO_MAXTIMETOREACHQUEUE



    Exit Function



ERROR_Execute:

    App.LogEvent "QueuePO.CQueuePO -> Execute Error: " & _

                 vbCrLf & Err.Description, vbLogEventTypeError



    ' Set warning level.

    IPipelineComponent_Execute = 2

    Resume Next



End Function

Option Explicit



' MSMQ constants.



' Access modes.

Const MQ_RECEIVE_ACCESS = 1

Const MQ_SEND_ACCESS = 2

Const MQ_PEEK_ACCESS = 32



' Sharing modes.
Const MQ_DENY_NONE = 0

Const MQ_DENY_RECEIVE_SHARE = 1



' Transaction options.
Const MQ_NO_TRANSACTION = 0

Const MQ_MTS_TRANSACTION = 1

Const MQ_XA_TRANSACTION = 2

Const MQ_SINGLE_MESSAGE = 3



' Error messages.

Const MQ_ERROR_QUEUE_NOT_EXIST = -1072824317



' MQ Message ACKNOWLEDGEMENT.

Const MQMSG_ACKNOWLEDGMENT_FULL_REACH_QUEUE = 5

Const MQMSG_ACKNOWLEDGMENT_FULL_RECEIVE = 14

Const DEFAULT_MAX_TIME_TO_REACH_QUEUE = 20


' MQ Message ACKNOWLEDGEMENT.

Const MQMSG_ACKNOWLEDGMENT_FULL_REACH_QUEUE = 5

Const MQMSG_ACKNOWLEDGMENT_FULL_RECEIVE = 14



Function WritePO2MSMQ(sQueueName As String, sMsgBody As String, _
 sMsgLabel As String, 
 sServerName As String, Optional MaxTimeToReachQueue As Variant) As Long



    Dim lMaxTime As Long



    If IsMissing(MaxTimeToReachQueue) Then

    lMaxTime = DEFAULT_MAX_TIME_TO_REACH_QUEUE

    Else

    lMaxTime = MaxTimeToReachQueue

    End If



    Dim objQueueInfo As MSMQ.MSMQQueueInfo

    Dim objQueue As MSMQ.MSMQQueue, objAdminQueue As MSMQ.MSMQQueue

    Dim objQueueMsg As MSMQ.MSMQMessage



    On Error GoTo MSMQ_Error



    Set objQueueInfo = New MSMQ.MSMQQueueInfo

    objQueueInfo.FormatName = "DIRECT=OS:" & sServerName & "\PRIVATE$\" &_
                          sQueueName



    Set objQueue = objQueueInfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)



    Set objQueueMsg = New MSMQ.MSMQMessage



    objQueueMsg.Label = sMsgLabel      ' Set the message label property

    objQueueMsg.Body = sMsgBody        ' Set the message body property

    objQueueMsg.Ack = MQMSG_ACKNOWLEDGMENT_FULL_REACH_QUEUE

    objQueueMsg.MaxTimeToReachQueue = lMaxTime



    objQueueMsg.send objQueue, MQ_SINGLE_MESSAGE



    objQueue.Close



On Error Resume Next

    Set objQueueMsg = Nothing

    Set objQueue = Nothing

    Set objQueueInfo = Nothing



    Exit Function



MSMQ_Error:

    App.LogEvent "Error in WritePO2MSMQ: " & Error

    Resume Next



End Function

< xsl:stylesheet xmlns:xsl='http://www.w3.org/1999/XSL/Transform' 

  xmlns:msxsl='urn:schemas-microsoft-com:xslt' xmlns:var='urn:var' 

  xmlns:user='urn:user' exclude-result-prefixes='msxsl var user' 

  version='1.0'>

< xsl:output method='xml' omit-xml-declaration='yes' />

< xsl:template match='/'>

      < xsl:apply-templates select='ORDERS01'/>

< /xsl:template>

< xsl:template match='ORDERS01'>

      < orderform>


           'Connection from source node "BELNR" to destination node "OrderID"


    
               < xsl:if test='E2EDK02/@BELNR'>

                  < xsl:attribute name='OrderID'>

                           < xsl:value-of select='E2EDK02/@BELNR'/>

                  < /xsl:attribute>

               < /xsl:if>

      < /orderform>

< /xsl:template>

< /xsl:stylesheet>

< %@ Language="VBScript" %>



< % 

const TEMPORARY_FOLDER = 2



call Main()




Sub Main()

      call ProcessOrderStatus( ParseRequestForm() )

End Sub




Sub ProcessOrderStatus(sDocument)



Dim oOrderGroupMgr 

Dim oOrderGroup 

Dim rs

Dim sPONum
 
Dim oAttr 

Dim vResult

Dim vTracking 

Dim oXML

Dim dictConfig

Dim oElement



    Set oOrderGroupMgr = Server.CreateObject("CS_Req.OrderGroupManager")

    Set oOrderGroup = Server.CreateObject("CS_Req.OrderGroup")



    Set oXML = Server.CreateObject("MSXML.DOMDocument")

    oXML.async = False



    If oXML.loadXML (sDocument) Then


              ' Get the orderform element.

              Set oElement = oXML.selectSingleNode("/orderform")



              ' Get the poNum.

              sPONum = oElement.getAttribute("OrderID")



              Set dictConfig = _
                      Application("MSCSAppConfig").GetOptionsDictionary("")



              ' Use ordergroupmgr to find the order by OrderID.

              oOrderGroupMgr.Initialize _
                                (dictConfig.s_CatalogConnectionString)

              Set rs = oOrderGroupMgr.Find(_
    Array("order_requisition_number='" sPONum & "'"), Array(""), Array(""))



              If rs.EOF And rs.BOF Then

                      'Create a new one. - Not implemented in this version.

              Else

                      ' Edit the current one.

                      oOrderGroup.Initialize _
                         dictConfig.s_CatalogConnectionString, rs("User_ID")



                      ' Load the found order.

                      oOrderGroup.LoadOrder rs("ordergroup_id")



                      ' For the purposes of prototype, we only update the _
                      'status

                      oOrderGroup.Value.order_status_code = 2    
                                                       ' 2 = Saved order



                      ' Save it

                      vResult = oOrderGroup.SaveAsOrder(vTracking)



              End If

    Else

              WriteError "Unable to load received XML into DOM."

    End If



End Sub


Function ParseRequestForm()


    Dim PostedDocument

    Dim ContentType

    Dim CharSet

    Dim EntityBody

    Dim Stream

    Dim StartPos

    Dim EndPos



    ContentType = Request.ServerVariables( "CONTENT_TYPE" )



    ' Determine request entity body character set (default to us-ascii).

    CharSet = "us-ascii"

    StartPos = InStr( 1, ContentType, "CharSet=""", 1)

    If (StartPos > 0 ) then

            StartPos = StartPos + Len("CharSet=""")

            EndPos = InStr( StartPos, ContentType, """",1 )

            CharSet = Mid (ContentType, StartPos, EndPos - StartPos )

    End If



    ' Check for multipart MIME message.

    PostedDocument = ""



    if ( ContentType = "" or Request.TotalBytes = 0) then



            ' Content-Type is required as well as an entity body.

            Response.Status = "406 Not Acceptable"

            Response.Write "Content-type or Entity body is missing" & VbCrlf

            Response.Write "Message headers follow below:"  & VbCrlf

            Response.Write Request.ServerVariables("ALL_RAW") & VbCrlf

            Response.End

    Else

            If ( InStr( 1,ContentType,"multipart/" ) >