Dim sTargetQueue, sAdminQueue, sMessageBody, bCreateQueues
Dim lAppSpecific, iMaxWaitTime, bRemoveMessage, bCleanupQueue
Dim bCleanupAdminQueue, bLogDetail, sComputer
Dim oApi, oBag
Dim bIsCluster, WshShell, objWshShell, sName
Dim wshNetwork, sUser, sDomain, sMessage
Dim sStep
Dim oTargetQueue, oAdminQueue, q, oAdminQueueInfo, oMessage, iResult, iTotalSeconds
Dim bConnectToTargetQueue, bConnectToAdminQueue, bCreateMessage, bSendMessage, bGetResponse
Dim bScriptCompleted
sMessage = "Script started. " & VbCrLf & _
"TargetQueue: " & sTargetQueue & VbCrLf & _
"AdminQueue: " & sAdminQueue & VbCrLf & _
"Computer: " & wshNetwork.ComputerName & VbCrLf & _
"Domain: " & sDomain & VbCrLf & _
"User: " & sUser
Call LogDetail(EVENTNO_SCRIPTSTARTED,sMessage)
On Error Resume Next
bScriptCompleted = False
sStep = "Connecting to target queue."
Call LogDetail(EVENTNO_ADMINQUEUE,"Connecting to target queue: " & sTargetQueue)
Set oTargetQueue = GetQueue(sTargetQueue,MQ_SEND_ACCESS,bCreateQueues)
If Err = 0 Then
bConnectToTargetQueue = True
sStep = "Connecting to admin queue."
Set q = GetQueueInfo(sTargetQueue)
If q.IsTransactional = 1 Then
sAdminQueue = GetQueueServer(sAdminQueue,"\") & ADMIN_TEST_QUEUE
End If
Call LogDetail(EVENTNO_TARGETQUEUE,"Connecting to admin queue: " & sAdminQueue)
Set oAdminQueue = GetQueue(sAdminQueue,MQ_RECEIVE_ACCESS,bCreateQueues)
If Err = 0 Then
bConnectToAdminQueue = True
sStep = "Creating message."
Call LogDetail(EVENTNO_CREATEMESSAGE,"Creating message." & VbCrLf & "Body: " & sMessageBody & VbCrLf & "App Specific: " & lAppSpecific)
Set oAdminQueueInfo = GetQueueInfo(sAdminQueue)
Set oMessage = CreateMessage(sMessageBody,lAppSpecific,MQMSG_ACKNOWLEDGMENT_FULL_REACH_QUEUE,oAdminQueueInfo,iMaxWaitTime)
If Err = 0 Then
bCreateMessage = True
sStep = "Sending message."
Call LogDetail(EVENTNO_SENDINGMESSAGE,"Sending message.")
Call Send(oMessage, oTargetQueue, sTargetQueue)
If Err = 0 Then
bSendMessage = True
sStep = "Waiting for response message."
Call LogDetail(EVENTNO_WAITING,"Waiting for response message.")
iResult = WaitForResponse(oAdminQueue,oMessage.Id,iMaxWaitTime,iTotalSeconds,bCleanupAdminQueue,lAppSpecific)
If Err = 0 Then
bGetResponse = True
bScriptCompleted = True
sStep = "Removing original message."
Call LogDetail(EVENTNO_REMOVEMESSAGE,"Removing test message from destination queue.")
If iResult < 4 And bCleanupQueue Then
Set oTargetQueue = GetQueue(sTargetQueue,MQ_RECEIVE_ACCESS,False)
Call RemoveOriginalMessage(oTargetQueue,oMessage.Id)
If Err = 0 Then
bRemoveMessage = True
End If
End If
If Err = 0 Then
sStep = "Script completed."
End If
Else
bGetResponse = False
bRemoveMessage = False
End If
Else
bSendMessage= False
bGetResponse = False
bRemoveMessage = False
End If
Else
bCreateMessage = False
bSendMessage= False
bGetResponse = False
bRemoveMessage = False
End If
Else
bConnectToAdminQueue = False
bCreateMessage = False
bSendMessage= False
bGetResponse = False
bRemoveMessage = False
End If
Else
bConnectToTargetQueue = False
bConnectToAdminQueue = False
bCreateMessage = False
bSendMessage = False
bGetResponse = False
bRemoveMessage = False
End If
sMessage = "Script ended." & VbCrLf & _
"TargetQueue: " & sTargetQueue & VbCrLf & _
"AdminQueue: " & sAdminQueue & VbCrLf & _
"Domain: " & sDomain & VbCrLf & _
"User: " & sUser & VbCrLf & _
"Result: " & iResult & VbCrLf & _
"Seconds: " & iTotalSeconds & VbCrLf & _
"ConnectToTargetQueue: " & bConnectToTargetQueue & VbCrLf & _
"ConnectToAdminQueue: " & bConnectToAdminQueue & VbCrLf & _
"CreateMessage: " & bCreateMessage & VbCrLf & _
"SendMessage: " & bSendMessage & VbCrLf & _
"GetResponse: " & bGetResponse & VbCrLf & _
"RemoveMessage: " & bRemoveMessage & VbCrLf & _
"ScriptCompleted: " & bScriptCompleted & VbCrLf & _
"FinalStep: " & sStep & VbCrLf & _
"ErrorNumber: " & Err.Number & VbCrLf & _
"ErrorDescription: " & Err.Description
Call LogDetail(EVENTNO_SCRIPTENDED,sMessage)
objWshShell.Remove("_CLUSTER_NETWORK_NAME_")
objWshShell.Remove("_CLUSTER_NETWORK_HOSTNAME_")
End If
Call oAPI.Return(oBag)
Function GetQueueServer(Path, Symbol)
If InStr(Path,Symbol) > 0 Then
GetQueueServer = Left(Path,InStr(Path,Symbol)-1)
Else
GetQueueServer = Path
End If
End Function
Function IsCluster()
Dim wshNetwork
Set wshNetwork = CreateObject("Wscript.Network")
if StrComp(wshNetwork.ComputerName, GetQueueServer(sComputer,"."), 1) <> 0 then
IsCluster = True
else
IsCluster = False
End if
End Function
Function CreateMessage(Body,AppSpecific,Ack,AdminQueue,MaxTime)
Dim qm
Set qm = CreateObject("MSMQ.MSMQMessage")
qm.Delivery = MQMSG_DELIVERY_EXPRESS
qm.Ack = Ack
Set qm.AdminQueueInfo = AdminQueue
qm.Body = Body
qm.AppSpecific = AppSpecific
qm.MaxTimeToReachQueue = MaxTime
Set CreateMessage = qm
End Function
Function GetQueue(PathName,Access,CreateQueue)
Dim q, qi, Message, FormatName
On Error Resume Next
Set q = CreateObject("MSMQ.MSMQQueue")
If CreateQueue = True Then
Set qi = CreateObject("MSMQ.MSMQQueueInfo")
qi.PathName = PathName
qi.Create()
If Err = 0 Then
Message = "Queue " & PathName & " created by Operations Manager 2007 for testing monitor."
Call oAPI.LogScriptEvent(SCRIPT_NAME,EVENTNO_QUEUECREATED,EVENT_LEVEL_INFO,Message)
Else
Err.Clear
End If
End If
Set qi = CreateObject("MSMQ.MSMQQueueInfo")
FormatName = "DIRECT=OS:" & PathName
qi.FormatName = FormatName
Set q = qi.Open(Access,MQ_DENY_NONE)
Set GetQueue = q
End Function
Function GetQueueInfo(PathName)
Dim qi
Set qi = CreateObject("MSMQ.MSMQQueueInfo")
qi.PathName = PathName
Set GetQueueInfo = qi
End Function
Sub Send(QueueMessage, TargetQueue, sTargetQueue)
Dim q, xdispenser, xact
Set q = GetQueueInfo(sTargetQueue)
If q.IsTransactional = 1 Then
Set xdispenser = CreateObject("MSMQ.MSMQTransactionDispenser") ' Used for internal transactions
Set xact = CreateObject("MSMQ.MSMQTransaction")
Set xact = xdispenser.BeginTransaction
QueueMessage.Send TargetQueue, xact
xact.Commit
Else
QueueMessage.Send TargetQueue
End If
End Sub
Function WaitForResponse(Queue,Id,MaxTimeSeconds,ByRef TotalSeconds,Cleanup,AppSpecific)
Dim dStart, MessageFound, Message
dStart = Now
MessageFound = False
Do While (MessageFound = False) And (CInt(DateDiff("s",dStart,Now)) < CInt(MaxTimeSeconds))
Set Message = Queue.PeekCurrent(False,False,0)
Do While Not Message Is Nothing
If CompareId(Message.CorrelationId,Id) = True Then
TotalSeconds = DateDiff("s",dStart,Now)
If Cleanup = True Then
Set Message = Queue.ReceiveCurrent
End If
WaitForResponse = Message.MsgClass
Exit Function
Else
If Cleanup = True And CStr(Message.AppSpecific) = CStr(AppSpecific) Then
Set Message = Queue.ReceiveCurrent(False,False,0)
Set Message = Queue.PeekCurrent(False,False,0)
Else
Set Message = Queue.PeekNext(False,False,1000)
End If
End If
Loop
Loop
WaitForResponse = -1
End Function
Sub RemoveOriginalMessage(Queue,Id)
Dim MessageFound, Message
On Error Resume Next
MessageFound = False
Set Message = Queue.PeekCurrent(False,False,0)
Do While Not Message Is Nothing
If CompareId(Message.Id,Id) = True Then
MessageFound = True
Set Message = Queue.ReceiveCurrent(False,False,0)
If Err <> 0 Then Call ThrowScriptError(EVENTNO_REMOVEMESSAGE_ERROR,EVENT_LEVEL_WARNING,"Test message was delivered successfully but could not be removed.",true)
Exit Do
Else
Set Message = Queue.PeekNext(False,False,1000)
End If
Loop
If MessageFound = False Then Call ThrowScriptError(EVENTNO_REMOVEMESSAGE_ERROR,EVENT_LEVEL_WARNING,"Test message was delivered successfully but could not be located in order to be removed.",true)
End Sub
Function CompareId(Id1,Id2)
Dim i
CompareId = True
For i = 1 To 20
If Midb(Id1, i, 1) <> Midb(Id2, i, 1) Then
CompareId = False
End If
Next
End Function
Sub LogDetail(EventNo,Message)
Message = VbCrLf & "Calling MP Element ID: $MPElement$" & vbcrlf & Message
If bLogDetail = True Then
Call oAPI.LogScriptEvent(SCRIPT_NAME,EventNo,EVENT_LEVEL_INFO,Message)
End If
End Sub
Sub ThrowScriptError(EventNo,Severity,Message,Abort)
sMessage = VbCrLf & sMessage & VbCrLf & _
Err.Description
Call oAPI.LogScriptEvent(SCRIPT_NAME,EventNo,Severity,Message)
If Abort = True Then WScript.Quit
Home
KOR 
Show References: