Partilhar via


"How can I tell if the destination is available before sending my MSMQ message?" #1

This is sort of defeating the main point of using MSMQ - that is, being able to send a message without worrying if the destination is available or not - but there may be a good business reason for wanting to.

Just because a machine is on-line does not mean that the MSMQ service itself is up and running. So just sending an ICMP PING to the IP address of the machine is not as helpful as you'd think.

One option is to use MSMQ's own MQPing system. As discussed here, MQPing sends a normal MSMQ message labelled "QM-Admin Commands" and there will be a corresponding message returned to the sender labelled "Ping Response". So you could send and your receive your own MQPIng message from within your application.

Here's some sample VBScript that Yoel Arnon wrote many years ago that shows the principle:

<Job ID="MQPing">

<?Job Debug="True"?>

<Reference Object="MSMQ.MSMQApplication"/>

<Script language="VBScript">

' Author: Yoel Arnon (yoel@msmq.biz)

' Date: 05-Jul-2001

' Purpose: MQping using DIRECT format name.

' Can be used for Workgroup, cross enterprise ping, as well as regular MQPing.

'

Option Explicit

Dim objArgs

Set objArgs = WScript.Arguments

if (objArgs.Count = 0) Then

WScript.Echo "Usage: MQping <MSMQ Computer to Ping> [<Timeout in seconds>]"

WScript.Quit

End If

Dim TimeOut

if (objArgs.Count > 1) Then

TimeOut = objArgs(1) * 1000 ' Miliseconds

Else

TimeOut = 30000 ' 30 seconds

End If

Dim ComputerToPing

ComputerToPing = objArgs(0)

'

' Ping messages are sent to the target's admin queue

'

Dim RemoteAdminQI

Set RemoteAdminQI = WScript.CreateObject("MSMQ.MSMQQueueInfo")

RemoteAdminQI.FormatName = "DIRECT=OS:" + ComputerToPing + "private$admin_queue$"

Dim RemoteAdminQ

Set RemoteAdminQ = RemoteAdminQI.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)

Dim LocalRespQI

Set LocalRespQI = WScript.CreateObject("MSMQ.MSMQQueueInfo")

LocalRespQI.PathName = ".Private$PingRespQ"

On Error Resume Next

'

' Delete queue if exist - may contain old response messages

'

LocalRespQI.Delete()

On Error Goto 0

LocalRespQI.Create()

Dim WshNetwork

Set WshNetwork = WScript.CreateObject("WScript.Network")

'

' Build a DIRECT format name on my computer for the response queue

' Note: although the response queue already contains a format name, it may not be a DIRECT one.

'

LocalRespQI.formatName = "DIRECT=OS:" + WshNetwork.ComputerName + "Private$PingRespQ"

Dim LocalRespQ

Set LocalRespQ = LocalRespQI.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE)

'

' Send the Ping Message

'

Dim AdminMsg

Set AdminMsg = WScript.CreateObject("MSMQ.MSMQMessage")

'

' Ping message format:

' Label must be "QM-Admin Commands"

' Body contains "Ping=" and response string

' Ping reply will be sent to response queue

'

AdminMsg.Label = "QM-Admin Commands"

AdminMsg.Body = "Ping=" & ComputerToPing

AdminMsg.MaxTimeToReachQueue = TimeOut

Set AdminMsg.ResponseQueueInfo = LocalRespQI

AdminMsg.Send RemoteAdminQ

'

' Wait for response

'

Dim ReturnMsg

Set ReturnMsg = LocalRespQ.Receive(,,,TimeOut)

if ReturnMsg Is Nothing Then

WScript.Echo "MQPing Failed"

Else

'

' Check reply

' Reply begins with one NULL byte, then unicode "=" and then the response string,

' but no NULL terminator. We want to see if this is equal to what we sent.

' We have no choice but comparing the prefix (we may, for example, confuse the

' reply from "comp" and "comp01", but this is a risk we should take).

'

Dim RespondingComputer

RespondingComputer = MidB(ReturnMsg.Body,4) ' Excluding a leading NULL byte and Unicode "="

' Note - the response may contain extra characters. We should look at the prefix

if ComputerToPing = LeftB(RespondingComputer, lenB(ComputerToPing)) Then

WScript.Echo "MQPing Succeeded"

Else

WScript.Echo "Someone else answered your MQPing - Please Re-Run MQPing"

End If

End if

</script>

</job>