Dim sComputer, bLogDetail, oAPI
Dim sRegRoot
Dim wshNetwork, sDomain, sUser,sMessage
Dim bIsCluster, WshShell, objWshShell, sName
Dim oApp, oQueueInfo
Dim iTotalQueueCount, sQueue, aPublicQueues, i
sRegRoot = MSMQ_REGROOT & "\" & sComputer & "\" & PUBLICQUEUE_VALUENAME
Set oAPI = CreateObject("MOM.ScriptAPI")
Set wshNetwork = CreateObject("Wscript.Network")
sDomain = wshNetwork.UserDomain
sUser = wshNetwork.UserName
sMessage = "Starting queue statistic collection." & VbCrLf & _
"Network: " & wshNetwork.ComputerName & VbCrLf & _
"User credentials: " & sDomain & "\" & sUser
Call LogDetail(EVENTNO_SCRIPT_STARTED,sMessage)
bIsCluster = false
If IsCluster = True then
bIsCluster = true
set WshShell = CreateObject("WScript.Shell")
set objWshShell = WshShell.Environment("Process")
sName = GetQueueServer(sComputer)
objWshShell("_CLUSTER_NETWORK_NAME_") = sName
objWshShell("_CLUSTER_NETWORK_HOSTNAME_") = sName
End If
Set oApp = CreateObject("MSMQ.MSMQApplication")
Set oQueueInfo = CreateObject("MSMQ.MSMQQueueInfo")
oApp.Machine = sComputer
iTotalQueueCount = 0
'Private Queues
For Each sQueue In oApp.PrivateQueues
Call LogDetail(EVENTNO_CALLINGQUEUE,"Collecting statistics for " & sQueue & ".")
Call CollectQueueStats(sComputer,GetPrivateQueue(sQueue))
Next
'Public Queues
Call LogDetail(EVENTNO_DISCOVER_PUBLICQUEUES,"Discovering public queues for queue statistic collection.")
aPublicQueues = GetPublicQueues(sComputer)
For i = 0 To UBound(aPublicQueues)-1
Call CollectQueueStats(sComputer,aPublicQueues(i))
Next
'Return
If iTotalQueueCount > 0 Then
Call LogDetail(EVENTNO_SCRIPT_ENDED,"Script ended. Data returned for " & iTotalQueueCount & " queues.")
Else
'We have no active queues with data. To avoid an error, we need to return an empty property bag.
Call CreateEmptyPropertyBag()
Call LogDetail(EVENTNO_SCRIPT_ENDED,"Script ended but no active queues were found. No data was returned by the script.")
End If
if bIsCluster = true then
objWshShell.Remove("_CLUSTER_NETWORK_NAME_")
objWshShell.Remove("_CLUSTER_NETWORK_HOSTNAME_")
End If
oAPI.ReturnItems()
Sub CollectQueueStats(Computer,Queue)
Dim oQueueStat, oMgmt, sFormatname, oQueueInfo, oMessage, oQueue
Set oQueueStat = New QueueStat
Set oMgmt = CreateObject("MSMQ.MSMQManagement")
sFormatName = "DIRECT=OS:" & Queue.PathName
On Error Resume Next
Call oMgmt.Init(Computer, ,sFormatName)
If Err.Number = 0 Then
Call LogDetail(EVENTNO_QUEUECONNECTION,"Connected to " & QueuePath & " on " & Computer & ".")
On Error GoTo 0
Else
'If we get an error, we either have a public queue not hosted by the specified machine
'or the queue is not active.
Call LogDetail(EVENTNO_QUEUESKIPPED,"Skipping " & QueuePath & " on " & Computer & ".")
On Error GoTo 0
Exit Sub
End If
'If the queue has a quota, calculated percentage
If Queue.Quota > 0 Then
oQueueStat.QuotaPctg = oQueueStat.KBytesInQueue / Queue.Quota * 100
Else
oQueueStat.QuotaPctg = 0
End If
'If the queue has journal enabled, check its usage.
If Queue.JournalEnabled <> 0 Then
'If a journal quota is defined, calculate the usage percentage.
If Queue.JournalQuota > 0 Then
oQueueStat.JournalQuotaPctg = oQueueStat.KBytesInJournalQueue / Queue.JournalQuota * 100
Else
oQueueStat.JournalQuotaPctg = 0
End If
End If
On Error Resume Next
Set oQueueInfo = CreateObject("MSMQ.MSMQQueueInfo")
oQueueInfo.FormatName = "DIRECT=OS:" & Queue.PathName
Set oQueue = oQueueInfo.Open(MQ_PEEK_ACCESS,MQ_DENY_NONE)
If Err <> 0 Then
Select Case Err.Number
Case -1072824283
oQueueStat.ConnectionStatus = "Access Denied"
Case Else
oQueueStat.ConnectionStatus = "Unknown Failure"
End Select
On Error GoTo 0
Else
On Error GoTo 0
oQueueStat.ConnectionStatus = "Success"
'If there are messages in the queue, check oldest and newest.
If oQueueStat.MessagesInQueue > 0 Then
Set oMessage = oQueue.PeekCurrent
oQueueStat.OldestMessageDateTime = oMessage.ArrivedTime
oQueueStat.OldestMessageAge = DateDiff("s",oQueueStat.OldestMessageDateTime,Now)
Do While Not oMessage Is Nothing
oQueueStat.NewestMessageDateTime = oMessage.ArrivedTime
oQueueStat.NewestMessageAge = DateDiff("s",oQueueStat.NewestMessageDateTime,Now)
Set oMessage = oQueue.PeekNext(False,False,0)
Loop
oQueue.Close
sMessage = "Computer Name: " & oQueueStat.ComputerName & VbCrLf & _
"Queue Path: " & oQueueStat.QueuePath & VbCrLf & _
"Connection Status: " & oQueueStat.ConnectionStatus & VbCrLf & _
"Messages In Queue: " & oQueueStat.MessagesInQueue & VbCrLf & _
"KBytes In Queue: " & oQueueStat.KBytesInQueue & VbCrLf & _
"Quota: " & oQueueInfo.Quota & VbCrLf & _
"Quota Pctg: " & oQueueStat.QuotaPctg & VbCrLf & _
"Messages In Journal Queue: " & oQueueStat.MessagesInJournalQueue & VbCrLf & _
"KBytes In Journal Queue: " & oQueueStat.KBytesInJournalQueue & VbCrLf & _
"Journal Quota: " & oQueueInfo.JournalQuota & VbCrLf & _
"Journal Quota Pctg: " & oQueueStat.JournalQuotaPctg & VbCrLf & _
"Oldest Message DateTime: " & oQueueStat.OldestMessageDateTime & VbCrLf & _
"Oldest Message Age: " & oQueueStat.OldestMessageAge & VbCrLf & _
"Newest Message DateTime: " & oQueueStat.NewestMessageDateTime & VbCrLf & _
"Newest Message Age: " & oQueueStat.NewestMessageAge
Call LogDetail(EVENTNO_STATSSUBMITTED,sMessage)
End Sub
Function GetPublicQueues(Computer)
Dim oReg, i, sQueue, NewQueue, sMessage, aQueues, sValue
Set oReg=GetObject("winmgmts:\\" & Computer & "\root\default:StdRegProv")
Call oReg.EnumKey(HKEY_LOCAL_MACHINE,sRegRoot,aQueues)
On Error Resume Next
i = 0
For Each sQueue In aQueues
ReDim Preserve PublicQueues(i)
Set NewQueue = New Queue
oReg.GetStringValue HKEY_LOCAL_MACHINE,sRegRoot & "\" & sQueue,"FormatName",sValue
NewQueue.FormatName = sValue
oReg.GetStringValue HKEY_LOCAL_MACHINE,sRegRoot & "\" & sQueue,"PathName",sValue
NewQueue.PathName = sValue
oReg.GetStringValue HKEY_LOCAL_MACHINE,sRegRoot & "\" & sQueue,"Quota",sValue
NewQueue.Quota = sValue
oReg.GetStringValue HKEY_LOCAL_MACHINE,sRegRoot & "\" & sQueue,"JournalEnabled",sValue
NewQueue.JournalEnabled = sValue
oReg.GetStringValue HKEY_LOCAL_MACHINE,sRegRoot & "\" & sQueue,"JournalQuota",sValue
NewQueue.JournalQuota = sValue
Set PublicQueues(i) = NewQueue
i=i+1
Next
ReDim Preserve PublicQueues(i)
If Err <> 0 Then
sMessage = VbCrLf & "Public Queues registry key not found." & VbCrLf & _
sRegRoot & "."
Call ThrowScriptError(EVENTNO_ERROR_REGKEYNOTFOUND,EVENT_LEVEL_WARNING,sMessage,False)
GetPublicQueues = Array("")
End If
GetPublicQueues = PublicQueues
End Function
Function GetPrivateQueue(PathName)
Dim QueueInfo, NewQueue, sMessage
Set QueueInfo = CreateObject("MSMQ.MSMQQueueInfo")
Set NewQueue = New Queue
NewQueue.PathName = PathName
On Error Resume Next
oQueueInfo.PathName = PathName
oQueueInfo.Refresh
If Err <> 0 Then
sMessage = "Could not connect to queue " & QueuePath & " to collect statistics." & VbCrLf & _
"Error number: " & Err.Number & VbCrLf & _
"Error Description: " & Err.Description
Call ThrowScriptError(EVENTNO_ERROR_COULDNOTOPENQUEUE,EVENT_LEVEL_WARNING,sMessage,False)
Else
NewQueue.FormatName = oQueueInfo.FormatName
NewQueue.Quota = oQueueInfo.Quota
NewQueue.JournalEnabled = oQueueInfo.Journal
NewQueue.JournalQuota = oQueueInfo.JournalQuota
End If
Set GetPrivateQueue = NewQueue
End Function
Sub ThrowScriptError(EventNo,Severity,Message,Abort)
Message = VbCrLf & "Calling MP Element ID: $MPElement$" & VbCrLf & Message
Call oAPI.LogScriptEvent(SCRIPT_NAME,EventNo,Severity,Message)
If Abort = True Then WScript.Quit
End Sub
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
Function GetQueueServer(Path)
GetQueueServer = Left(Path,InStr(Path,".")-1)
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
Class QueueStat
Private Sub Class_Initialize()
MessagesInQueue = 0
KBytesInQueue = 0
QuotaPctg = 0
MessagesInJournalQueue = 0
KBytesInJournalQueue = 0
JournalQuotaPctg = 0
End Sub
Public ComputerName
Public QueuePath
Public MessagesInQueue
Public KBytesInQueue
Public QuotaPctg
Public MessagesInJournalQueue
Public KBytesInJournalQueue
Public JournalQuotaPctg
Public ConnectionStatus
Public OldestMessageDateTime
Public OldestMessageAge
Public NewestMessageDateTime
Public NewestMessageAge
End Class
Class Queue
Public ComputerName
Public PathName
Public FormatName
Public IsPublic
Public IsTransactional
Public Label
Public PrivilegeLevel
Public Quota
Public JournalEnabled
Public JournalQuota
Public AdsPath
Public IsTestQueue
Home
Show References: