Немного разобрался с очередями MSMQ.
Напишу несколько кусочков кода для работы.
Во первых в проекте нужно подключить Microsoft Mesage Queue 3.0 Object Librery (хранится в mqoa.dll). Должна быть установлена служба: "Очереди сообщений"
Далее можно работать с очередеми в приделах Active Directory
(Мне нужно было работать с очередями на компе другого домена, но не удалось со своего компа, прогу буду запускать там)
Создаем очередь:
- Код: Выделить всё
Dim qinfo As New MSMQQueueInfo
Dim strMachineName As String
Dim strQueLbl As String
strMachineName = "." ' . Означает свой компьютер
strQueLbl = "Andrey.test4"
qinfo.PathName = strMachineName & "\" & strQueLbl
qinfo.Create
Поиск очереди по лэблу:
- Код: Выделить всё
Dim query As New MSMQQuery
Dim qinfos As MSMQQueueInfos
Dim strQueLbl As String
Dim FindQueOnLabel As Variant
Dim qinfo As MSMQQueueInfo
strQueLbl = "Andrey.test2"
Set qinfos = query.LookupQueue(Label:=strQueLbl)
qinfos.Reset
Set qinfo = qinfos.Next
If qinfo Is Nothing Then
MsgBox "Очереди с лэйблом " & strQueLbl & " не найдено"
Else
Set FindQueOnLabel = qinfo
MsgBox "Очередь найдена!"
End If
Чтение тела сообщения из очереди:
- Код: Выделить всё
Dim qQueue As MSMQ.MSMQQueue
Dim qMessage As MSMQ.MSMQMessage
Dim qinfo As New MSMQQueueInfo
Dim i As Integer
Dim bytBody() As Byte
Dim strBody As String
qinfo.PathName = ".\Andrey.test"
Set qQueue = qinfo.Open(MQ_PEEK_ACCESS, MQ_DENY_NONE)
Set qMessage = qQueue.PeekCurrent(ReceiveTimeout:=300)
Do While Not (qMessage Is Nothing)
Select Case TypeName(qMessage.Body)
Case "Long"
MsgBox CStr(qMessage.Body)
Case "String"
MsgBox qMessage.Body
Case "Byte()"
ReDim bytBody(qMessage.BodyLength)
bytBody = qMessage.Body
strBody = ""
For i = LBound(bytBody) To UBound(bytBody)
strBody = strBody & Chr(bytBody(i))
Next i
MsgBox strBody
End Select
Set qMessage = qQueue.PeekNext(ReceiveTimeout:=300)
Loop
qQueue.Close
Удаляем все сообщения из очереди:
- Код: Выделить всё
Dim qQueue As MSMQ.MSMQQueue
Dim qMessage As MSMQ.MSMQMessage
Dim qinfo As New MSMQQueueInfo
Dim qmgmt As New MSMQManagement
Dim i As Integer
Dim bytBody() As Byte
Dim strPath As String
qinfo.PathName = ".\Andrey.test2"
Set qQueue = qinfo.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE)
qmgmt.Init Machine:="it-bes", PathName:="it-bes\andrey.test2"
For i = 1 To qmgmt.MessageCount
Set qMessage = qQueue.ReceiveCurrent(ReceiveTimeout:=300)
Next i
qQueue.Close
Отправляем сообщение в очередь:
- Код: Выделить всё
Dim qinfo As New MSMQQueueInfo
Dim qQueue As MSMQ.MSMQQueue
Dim msg As New MSMQMessage
qinfo.PathName = ".\Andrey.test2"
Set qQueue = qinfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)
msg.Label = "Это лэйбл"
msg.Body = "А это само тело сообщений"
msg.Send qQueue
qQueue.Close
Данные куски кода работоспособны, но их можно и нужно доделывать и усовершенствовать, чем сейчас и занимаюсь, создавая программу мониторинга очередей MSMQ.
Всем удачного освоения!!!
Андрей.