分享一段MSMQ消息队列的代码

Question

Option Explicit
'这是一个类的代码....
'消息到达触发的事件
Public Event MQArrived()
'消息队列事件对象
Private WithEvents MQEvent As MSMQEvent
'本地消息队列对象，等待创建
Dim queueInfo As MSMQQueueInfo  '--队列信息
'消息对象
Dim msg As MSMQMessage
'本地消息队列对象创建成功后，被连接的对象
Dim q As MSMQQueue
'消息内容
Public s_content As String
'消息内容中的指令和附加参数
Public msg_id As String
Public para As String
'计数，首次启动时不收消息
Private index As LongPublic Sub Init_Default()
On Error Resume Next
    index = 0
    '为防止首次启动加载过多消息
    Call Create_Local_MQQueue
    '删除本地创建的消息队列或者是已存在的消息队列
    Call Delete_Local_MQQueue
    '此时创建的消息队列才是新的消息队列
    Call Create_Local_MQQueue
End SubPublic Sub Init_BY_Path(ByVal private_path As String)
On Error Resume Next
    index = 0
    '为防止首次启动加载过多消息
    Call Create_BY_Path(private_path)
    '删除本地创建的消息队列或者是已存在的消息队列
    Call Delete_Local_MQQueue
    '此时创建的消息队列才是新的消息队列
    Call Create_BY_Path(private_path)
End SubPrivate Sub Create_BY_Path(ByVal private_path As String)
On Error Resume Next
    index = index + 1
    Set queueInfo = New MSMQQueueInfo
    
    queueInfo.PathName = ".\private$\" & private_path & ""    queueInfo.Create
    Set q = queueInfo.Open(MQACCESS.MQ_RECEIVE_ACCESS, MQSHARE.MQ_DENY_NONE)
    Set MQEvent = New MSMQEvent
    q.EnableNotification MQEvent
End Sub''解析数据
Private Sub Get_MsgAndPara()
On Error GoTo err
    Dim arr() As String
    
    arr = Split(s_content, "MSG_ID0=")
    msg_id = Split(arr(1), ";")(0)
    
    arr = Split(s_content, "PARA0=") '
    para = Split(arr(1), ";")(0)
    
    Exit Sub
err:
    err.Clear
End Sub
Private Sub MQEvent_Arrived(ByVal q As Object, ByVal cursor As Long)
On Error Resume Next
    Dim theq As MSMQQueue
    Dim str() As Byte
    
    If index > 0 Then
        Set theq = q
        Set msg = theq.Receive()
        
        str = msg.Body
        s_content = StrConv(str, vbUnicode)
        Call Get_MsgAndPara
        RaiseEvent MQArrived
        theq.EnableNotification MQEvent
    End If
End SubPrivate Sub Create_Local_MQQueue()
On Error Resume Next
    index = index + 1
    Set queueInfo = New MSMQQueueInfo
    
    queueInfo.PathName = ".\private$\L2MsgQueue"    queueInfo.Create
    Set q = queueInfo.Open(MQACCESS.MQ_RECEIVE_ACCESS, MQSHARE.MQ_DENY_NONE)
    Set MQEvent = New MSMQEvent
    q.EnableNotification MQEvent
End SubPublic Sub Delete_Local_MQQueue()
On Error Resume Next
    queueInfo.Delete
End Sub'调用示例Private WithEvents MSMQ As clsMSMQPrivate Sub Init_MQ()
On Error Resume Next
    Set MSMQ = New clsMSMQ
    MSMQ.Init_Default
End SubPrivate Sub Release_MQ()
On Error Resume Next
    MSMQ.Delete_Local_MQQueue
    Set MSMQ = Nothing
End Sub
Private Sub MSMQ_MQArrived()
On Error Resume Next    
    Dim msg_id As String
    Dim para  As String    Call Get_MsgAndPara(msg_id, para)
    para = CLng(para)
        
    Select Case msg_id
        Case "1"
'add your code here 
    End Select
End Sub由于代码是用于工业现场,程序长期不退出,所以Resume Next较多...接收的消息格式为.NET程序发来的字符串,其它的语言未测试.细心的朋友可以将这个函数再优化一下,我偷懒只解析了一对参数,呵呵.看最近VB版人气不高,分享一下代码....

Answer 1

Get_MsgAndPara
细心的朋友可以将这个函数再优化一下,我偷懒只解析了一对参数,呵呵.

Answer 2

为了能用上msmq，系统还得是win服务器版本的？还得另外配置？
没用过，表示不懂。

Answer 3

不知道MSMQ是神马东西......估计没几个人会用哦. 
不过刚刚搜索了一下,发现这东西被描述的很强大～

Answer 4

直接在头文件加上' ##############################################################################
' 功  能：MSMQ消息队列
' 作  者：AmeKen
' 版  权：AmeKen
' 日  期：2011-3-31
' 网  站：XXX
' E-mail：XXX
'* (******* 复制请保留以上信息 *******)
' ###########################################哈哈

Answer 5

又分享了一个AisaC 最近……