Set wshNetwork = CreateObject("Wscript.Network")
sDomain = wshNetwork.UserDomain
sUser = wshNetwork.UserName
sMessage = "Starting Script: " & SCRIPT_NAME & VbCrLf & _
"User credentials: " & sDomain & "\" & sUser & VbCrLf & _
"Network Name: " & wshNetwork.ComputerName & VbCrLf & _
"Computer Name: " & sComputer & VbCrLf & _
"Queue Path: " & sQueuePath & VbCrLf & _
"Logic: " & sLogic
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 oQueueInfo = CreateObject("MSMQ.MSMQQueueInfo")
Set oJournalInfo = CreateObject("MSMQ.MSMQQueueInfo")
Set oMgmt = CreateObject("MSMQ.MSMQManagement")
Set oJournalMgmt = CreateObject("MSMQ.MSMQManagement")
On Error resume next
oQueueInfo.PathName = sQueuePath
oQueueInfo.Refresh
oJournalInfo.FormatName = oQueueInfo.FormatName & ";JOURNAL"
Set oJournal = oJournalInfo.Open(MQ_RECEIVE_ACCESS,MQ_DENY_NONE)
Call oMgmt.Init(sComputer, , "DIRECT=OS:" & sQueuePath)
if Err <> 0 then
sMessage = "There was an error" & VbCrLf & _
"Error Number: " & Err.Number & VbCrLf & _
"Error Description: " & Err.Description
Call ThrowScriptError(EVENTNO_ERROR_BADLOGIC,EVENT_LEVEL_WARNING,sMessage)
End if
Set oInitialStats = New QueueStat
Set oRunningStats = New QueueStat
iMessagesRemoved = 0
dKBytesRemoved = 0
Select Case lcase(sLogic)
Case "quota"
bShowSummary = True
dTargetQuotaPctg = CDbl(WScript.Arguments(3))
While oRunningStats.JournalQuotaPctg > dTargetQuotaPctg
Set oMessage = oJournal.Receive(MQ_SINGLE_MESSAGE, False, True, 5, False)
oRunningStats.Refresh
iMessagesRemoved = iMessagesRemoved + 1
dLatestDateRemoved = oMessage.ArrivedTime
Wend
Case "purge"
bShowSummary = True
oJournal.Purge
oRunningStats.Refresh
Case "statistics"
bShowSummary = False
WScript.Echo oInitialStats.GetSummary
Case Else
sMessage = "Bad argument provided for trimming logic." & VbCrLf & _
"Possible values are quota, time, kbytes, or purge." & VbCrLf & _
"Argument provided: " & sLogic
Call ThrowScriptError(EVENTNO_ERROR_BADLOGIC,EVENT_LEVEL_WARNING,sMessage)
End Select
If bShowSummary = True Then
sMessage = "Messages were removed from queue journal." & VbCrLf & _
"Queue: " & sQueuePath & VbCrLf & _
"Algorithm: " & sLogic & VbCrLf & _
"Messages removed: " & iMessagesRemoved & VbCrLf & _
"KBytes removed: " & dKBytesRemoved & VbCrLf & _
"Latest date removed: " & dLatestDateRemoved & VbCrLf & _
VbCrLf & _
"Initial statistics: " & VbCrLf & _
oInitialStats.GetSummary & VbCrLf & _
VbCrLf & _
"Final statistics: " & VbCrLf & _
oRunningStats.GetSummary
Call oAPI.LogScriptEvent(SCRIPT_NAME,EVENTNO_MESSAGES_REMOVED,EVENT_LEVEL_WARNING,sMessage)
WScript.Echo sMessage
End If
if bIsCluster = true then
objWshShell.Remove("_CLUSTER_NETWORK_NAME_")
objWshShell.Remove("_CLUSTER_NETWORK_HOSTNAME_")
End If
If InStr(Path,".") > 0 Then
GetQueueServer = Left(Path,InStr(Path,".")-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
Sub ThrowScriptError(EventNo,Severity,Message)
Message = "Script aborted due to the following script error:" & VbCrLf & Message
Call oAPI.LogScriptEvent(SCRIPT_NAME,EventNo,Severity,Message)
WScript.Quit
End Sub
Class QueueStat
Private Sub Class_Initialize()
ComputerName = sComputer
QueuePath = sQueuePath
Me.Refresh
End Sub
Public Sub Refresh()
Quota = oQueueInfo.Quota
JournalQuota = oQueueInfo.JournalQuota
MessagesInQueue = oMgmt.MessageCount
KBytesInQueue = CDbl(oMgmt.BytesInQueue) / 1000
MessagesInJournalQueue = oMgmt.JournalMessageCount
KBytesInJournalQueue = CDbl(oMgmt.BytesInJournal) / 1000
If oQueueInfo.Quota > 0 Then
QuotaPctg = (CDbl(oMgmt.BytesInQueue) / 1000) / (CDbl(oQueueInfo.Quota)) * 100
Else
QuotaPctg = 0
End If
If oQueueInfo.JournalQuota > 0 Then
JournalQuotaPctg = (CDbl(oMgmt.BytesInJournal) / 1000) / (CDbl(oQueueInfo.JournalQuota)) * 100
Else
JournalQuotaPctg = 0
End If
End Sub
Public Function GetSummary
With Me
GetSummary = "Computer Name: " & .ComputerName & VbCrLf & _
"Queue Path: " & .QueuePath & VbCrLf & _
"Quota: " & .Quota & VbCrLf & _
"Journal Quota: " & .JournalQuota & VbCrLf & _
"Messages in Queue: " & .MessagesInQueue & VbCrLf & _
"KBytes in Queue: " & .KBytesInQueue & VbCrLf & _
"Quota Pctg: " & .QuotaPctg & VbCrLf & _
"Messages in Journal Queue: " & .MessagesInJournalQueue & VbCrLf & _
"KBytes in Journal Queue: " & .KBytesInJournalQueue & VbCrLf & _
"Journal Quota Pctg: " & .JournalQuotaPctg
End With
End Function
Public ComputerName
Public QueuePath
Public Quota
Public JournalQuota
Public MessagesInQueue
Public KBytesInQueue
Public QuotaPctg
Public MessagesInJournalQueue
Public KBytesInJournalQueue
Public JournalQuotaPctg