Figure 1    MQIS Functions

API Functions	ActiveX Methods
MQCreateQueue (for public queues)	Create (for public queues)
MQDeleteQueue (for public queues)	Delete (for public queues)
MQGetMachineProperties	MachineIdOfMachineName
MQGetQueueProperties	Refresh
MQGetQueueSecurity	IsWorldReadable
MQGetSecurityContext	AttachSecurityContext
MQLocateBegin	LookupQueue Reset
MQLocateNext	Next
MQOpenQueue (for public queues opened to receive messages)	Open (for public queues opened to receive messages)
MQPathNameToFormatName
MQSetQueueProperties	Update
MQSetQueueSecurity

Figure 3    MSMQ ActiveX Server Members

Properties
Property Name	Description
ApplicationName	Name of application that instantiated the object
Methods
Method Name	Parameter	Description
LogErr	Desc	Error message
	Number	Error number
	Procedure	Procedure in which error occurred
	Severity	Severity level (1=Immediate Attention; 2=Standard Logging; 3=System Reporting)

Figure 4   Instantiating the Error Object

 On Error GoTo EH
 
     Dim qRead As MSMQQueue
     Dim msg As New MSMQMessage
 
     'try and connect to MQIS
     Set qInfos = query.LookupQueue(Label:="Severity Level")
     qInfos.Reset
 
     Set qInfo = qInfos.Next
     Set qRead = qInfo.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE)
         
     Set msg = qRead.Peek(ReceiveTimeout:=1000)
     If IsNumeric(msg.Body) Then
         pvtSystemLevel = msg.Body
         SaveSetting "ErrHandler", "Logging", "LastLogLevel", pvtSystemLevel
     Else
         pvtSystemLevel = StandardLogging	'default to Standard logging
     End If
     qRead.Close
     
     'use the formatname to identify the queue
     qInfo.FormatName = "DIRECT=OS:rdu_nt4\sysmessages"  'hardcoded for example
     Set qMsg = qInfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)
     Exit Sub
     
 EH:
     If Err.Number = MQ_ERROR_NO_DS Then
         pvtSystemLevel = GetSetting("ErrHandler", "Logging", "LastLogLevel", 3)
         
         'use the formatname to identify the queue
         qInfo.FormatName = "DIRECT=OS:rdu_nt4\sysmessages"
         Set qMsg = qInfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)
    End If
    Exit Sub

Figure 5   LogErr Object

 Public Function LogErr(ByVal Desc As String, ByVal Number As Long, ByVal Procedure
 As String, ByVal Severity As SeverityLevels)
 
     Dim msg As New MSMQMessage
     
     If Severity <= pvtSystemLevel Then
         msg.Label = Trim$(Environ("COMPUTERNAME")) & " | " & _
                     Trim$(ApplicationName)
         msg.AppSpecific = Severity
         msg.Body = Format$(Now, "mm/dd/yy hh:mm:ss") & " (" & Number & ") " & _
                    Desc & " (" & Procedure & ")"
         msg.Delivery = MQMSG_DELIVERY_RECOVERABLE
         msg.Priority = 7
         msg.Send qMsg
         qMsg.Close
     End If
 End Function

Figure 8   Adding Orders to the Recordset

 ' Read cached recordset from disk
         rsOrder.Open App.Path & "\order.rs"
 
         rsOrder.AddNew
         rsOrder("user_id") = 1
         rsOrder("inventory_item") = cbSaleItem.ItemData(cbSaleItem.ListIndex)
         rsOrder("item_count") = Val(txtItemCount.Text)
         rsOrder("sale_date") = CDate(txtSaleDate.Text)
         rsOrder("purchaser") = Val(cbCustomer.ItemData(cbCustomer.ListIndex))
         rsOrder("comments") = Trim$(txtComments.Text)
         rsOrder.Update

Figure 9   Sending Recordset to the Queue

 Dim qInfo As New MSMQQueueInfo
     
     qInfo.Label = "New Orders"
 
     'hardy coded formatname for example purposes
     qInfo.FormatName = "DIRECT=OS:rdu_nt4\neworders"
     Set q = qInfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)
 
     msg.Label = sCustomerName & "|" & dtSale 
     msg.Body = rsOrder
     msg.Delivery = MQMSG_DELIVERY_RECOVERABLE
     msg.Priority = 7
     msg.Send q
     q.close   

Figure 10   FindOrders server

 On Error Goto ErrorHandler:
 
     Dim qry As New MSMQQuery
     Dim qInfo As MSMQQueueInfo
     Dim qInfos As MSMQQueueInfos
     Dim qReceive As MSMQQueue
     Dim msg As MSMQMessage
     Dim rs As Recordset
     Dim ctxObject As ObjectContext
     Set ctxObject = GetObjectContext()
 
     Set qInfos = qry.LookupQueue(Label:="New Orders")
     qInfos.Reset
     Set qInfo = qInfos.Next
 
     Set qReceive = qInfo.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE)
     Set msg = qReceive.Receive(MQ_MTS_TRANSACTION, False, True, 1000)
 
     Do While Not msg Is Nothing
         Set rs = msg.Body
         ProcessOrder rs
         Set msg = qReceive.Receive(MQ_MTS_TRANSACTION, , , 1000)
     Loop
 
     ctxObject.SetComplete
     Exit Function
 
 ErrorHandler:
     ctxObject.SetAbort
     Exit Function