COM+系列——实战演练MSMQ(消息队列)(二)

COM+系列——实战演练MSMQ(消息队列)(二)

龙卷风

关键字：COM+,MSMQ.

?

概述：

如何在MSMQ中传递ADO记录集可能是许多人比较关心的话题。这就意味着可以传递一些复杂的东西，如二进制字段内容等。MSMQ消息体中可以直接传递记录集。因为ADO记录集组件实现了IpresistStream接口。

还有一个问题就是如何同步接收发送方发送的消息。尽管MSMQ是异步传输，但是同步传输还是比较重要的。MSMQ提供了Arrived事件，类似WINSOCK.来完成这个功能

下面我们使用例子来阐述上面的两个问题。

开发环境:WinXP+VB6

消息的发送程序：

Option Explicit

?

Private Sub cmdQuit_Click()

Unload Me

End Sub

?

'引用Microsoft Message Queue 3.0 Object Library

Private Sub cmdSend_Click()

??? '创建MSMQ需要的变量

??? Dim qInfo As MSMQQueueInfo

??? Dim qObject As MSMQQueue

??? Dim qMessage As MSMQMessage

???

??? '实例化队列信息

??? Set qInfo = New MSMQQueueInfo

???

??? '队列路径

??? qInfo.PathName = "./Private$/TestQueue"

??? '队列名称

??? qInfo.Label = "Test Queue"

??? '队列优先权，支持八种。MQ_MIN_PPRIORITY是最低级,MQ_MAX_PRIORITY是最高级

??? qInfo.BasePriority = MQ_MIN_PRIORITY

???

??? '如果队列不存在,则创建

??? On Error GoTo CheckQueue:

??? qInfo.Create False, False

??? GoTo QueueCreated:

???

CheckQueue:

??? If Not Err.Number = MQ_ERROR_QUEUE_EXISTS Then

??????? MsgBox "错误: " + Hex(Err.Number) + Err.Source + Err.Description, vbCritical + vbOKOnly, "信息提示"

??? End If

???

QueueCreated:

??? '打开

??? Set qObject = qInfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)

???

??? Set qMessage = New MSMQMessage

???

??? Dim conn As New ADODB.Connection

??? Dim rs As New ADODB.Recordset

??? conn.Open "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Password=;Initial Catalog=northwind;Data Source=localhost"

???

??? rs.CursorLocation = adUseClient

??? rs.Open "select * from employees", conn, adOpenStatic, adLockReadOnly

???

??? '填充信息

??? qMessage.Label = txtMsgLabel.Text '消息标题

??? qMessage.Body = rs '将记录集作为消息内容发送

??? qMessage.Priority = lstPriority.Text '优先权(直接指定0-7数字即可)

???

??? '发送消息

??? qMessage.Send qObject, MQ_NO_TRANSACTION

???

??? '关闭

??? qObject.Close

???

??? '释放

??? Set qInfo = Nothing

??? Set qObject = Nothing

??? Set qMessage = Nothing

End Sub运行程序后，输入内容，选择优先级，发送。

?

?

消息的接收程序：部分注释与上面的相同

Option Explicit

Dim qInfo As New MSMQQueueInfo

Dim qObject As MSMQQueue

Dim WithEvents qMSMQEvent As MSMQEvent

'引用Microsoft Message Queue 3.0 Object Library

?

Private Sub cmdQuit_Click()

Unload Me

End Sub

?

Private Sub Form_Load()

??? '队列路径

??? qInfo.PathName = "./Private$/TestQueue"

??? '队列名称

??? qInfo.Label = "Test Queue"

??? '队列优先权，支持八种。MQ_MIN_PPRIORITY是最低级,MQ_MAX_PRIORITY是最高级

??? qInfo.BasePriority = MQ_MIN_PRIORITY

???

??? '如果队列不存在,则创建

??? On Error GoTo CheckQueue:

??? qInfo.Create False, False

??? GoTo QueueCreated:

???

CheckQueue:

??? If Not Err.Number = MQ_ERROR_QUEUE_EXISTS Then

??????? MsgBox "错误: " + Hex(Err.Number) + Err.Source + Err.Description, vbCritical + vbOKOnly, "信息提示"

??? End If

???

QueueCreated:

????? '打开

??? Set qObject = qInfo.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE)

???

??? '连接事件

??? Set qMSMQEvent = New MSMQEvent

??? qObject.EnableNotification qMSMQEvent, MQMSG_CURRENT, 1000

End Sub

Private Sub qMSMQEvent_Arrived(ByVal Queue As Object, ByVal Cursor As Long)

? '获取当前消息

? Dim qMessage As MSMQMessage

? Set qMessage = Queue.PeekCurrent

? MsgBox "有新消息来了" & qMessage.Label

?

? lblMsgLabel.Caption = qMessage.Label

? Dim rs As New ADODB.Recordset

? Set rs = qMessage.Body

? Set DataGrid1.DataSource = rs

?

? '得到下一条

? qObject.EnableNotification qMSMQEvent, MQMSG_NEXT, 10000

End Sub

?

Private Sub qMSMQEvent_ArrivedError(ByVal Queue As Object, ByVal ErrorCode As Long, ByVal Cursor As Long)

? MsgBox "发生错误" & ErrorCode

End Sub

?

?

运行后，就可以看到消息了，如下图所示：

?

MSMQ的内容暂时告一段落。希望我们能够交流。

源代码下载：