Dim SourceId, ManagedentityId, sComputer, sServiceName, bDiscoverPublicQueues, bDiscoverPrivateQueues, bWorkgroupServer, bLogDetail
Dim oApi, oDiscoveryData
Dim wshNetwork, sUser, sDomain, sMessage
Dim bIsCluster, WshShell, objWshShell, sName
Dim oMSMQApp
Dim sQueue, oQueue
Dim aPublicQueues, i
If IsMSMQServiceRunning = False Then
Call ThrowScriptError(EVENTNO_MSMQSERVICE_NOTRUNNING,EVENT_LEVEL_WARNING,"Queue Discovery did not execute because the MSMQ service is not running.",True)
End If
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
Set wshNetwork = CreateObject("Wscript.Network")
sUser = wshNetwork.UserName
sDomain = wshNetwork.UserDomain
sMessage = "Discovery started with following parameters: " & VbCrLf & _
"Source ID: " & SourceId & VbCrLf & _
"Managed Entity ID: " & ManagedEntityId & VbCrLf & _
"Computer: " & sComputer & VbCrLf & _
"Network: " & wshNetwork.ComputerName & VbCrLf & _
"Discover Public Queues: " & bDiscoverPublicQueues & VbCrLf & _
"Discover Private Queues: " & bDiscoverPrivateQueues & 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 oMSMQApp = CreateObject("MSMQ.MSMQApplication")
oMSMQApp.Machine = sComputer
oMSMQApp.Connect
'Private Queues
If bDiscoverPrivateQueues = True Then
Call LogDetail(EVENTNO_DISCOVER_PRIVATEQUEUES,"Discovering private queues.")
For Each sQueue In oMSMQApp.PrivateQueues
Set oQueue = NewQueueInstance(sComputer,sQueue,False)
If Not oQueue Is Nothing Then
Call SubmitQueue(oQueue)
Call WriteDetailEvent(oQueue)
End If
Next
Else
Call LogDetail(EVENTNO_BYPASS_PRIVATEQUEUES,"Bypassed discovery of private queues.")
End If
'Public Queues
Call InitializeRegistry(sComputer,MSMQ_REGROOT,PUBLICQUEUE_VALUENAME)
If bDiscoverPublicQueues = True And bWorkgroupServer = False Then
Call LogDetail(EVENTNO_DISCOVER_PUBLICQUEUES,"Discovering public queues.")
aPublicQueues = GetPublicQueues(sComputer)
For i = 0 To UBound(aPublicQueues)
Set oQueue = NewQueueInstance(sComputer,aPublicQueues(i),True)
If Not oQueue Is Nothing Then
Call SubmitQueue(oQueue)
Call WriteDetailEvent(oQueue)
Call WriteQueueToRegistry(oQueue,sComputer)
End If
Next
Else
Call LogDetail(EVENTNO_BYPASS_PUBLICQUEUES,"Bypassed discovery of public queues.")
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
Function GetPublicQueues(Computer)
Dim MSMQQuery, Queues, QueueInfo, QueueServer, Message
Dim PublicQueues()
ReDim PublicQueues(0)
Set MSMQQuery = CreateObject("MSMQ.MSMQQuery")
On Error Resume Next
Set Queues = MSMQQuery.LookupQueue()
Set QueueInfo = Queues.Next
If Err = 0 Then
On Error GoTo 0
While Not QueueInfo Is Nothing
QueueServer = Split(QueueInfo.PathNameDNS,"\")(0)
If lcase(Computer) = lcase(QueueServer) Then
PublicQueues(UBound(PublicQueues)) = QueueInfo.PathName
ReDim Preserve PublicQueues(UBound(PublicQueues)+1)
End If
Set QueueInfo = Queues.Next
Wend
Else
Message = "Error searching Active Directory while discovering public queues." & VbCrLf & _
"Error number: " & Err.Number & VbCrLf & _
"Error Description: " & Err.Description
On Error GoTo 0
Call ThrowScriptError(EVENTNO_ERROR_ADLOOKUP,EVENT_LEVEL_ERROR,Message,False)
End If
Function NewQueueInstance(Computer,QueuePath,PublicQueue)
Dim oQueue, QueueInfo, sMessage
Set oQueue = New Queue
oQueue.ComputerName = Computer
oQueue.PathName = QueuePath
oQueue.IsPublic = CBool(PublicQueue)
'Validate that we have access to the queue.
'If not, we will throw an error and continue.
'If so, we will gather available settings.
On Error Resume Next
Set QueueInfo = CreateObject("MSMQ.MSMQQueueInfo")
QueueInfo.PathName = QueuePath
QueueInfo.Refresh
If oQueue.IsPublic = True Then oQueue.AdsPath = QueueInfo.ADsPath
If QueueInfo.ServiceTypeGuid = "{55EE8F33-CCE9-11CF-B108-0020AFD61CE9}" Then
oQueue.IsTestQueue = True
Else
oQueue.IsTestQueue = False
End If
Set NewQueueInstance = oQueue
Else
On Error GoTo 0
sMessage = "Error connecting to queue: " & QueuePath & "." & VbCrLf & _
"Validate that the MSMQ Queue Access profile has access to read the queue properties."
Call ThrowScriptError(EVENTNO_ERROR_COULDNOTOPENQUEUE,EVENT_LEVEL_ERROR,sMessage,False)
Set NewQueueInstance = Nothing
End If
End Function
Sub SubmitQueue(NewQueue)
Dim oInstance
Set oInstance = oDiscoveryData.CreateClassInstance("$MPElement[Name='Microsoft.MSMQ.2008R2.Queues']$")
With oInstance
.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", NewQueue.ComputerName
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/PathName$",NewQueue.PathName
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/IsPublic$",NewQueue.IsPublic
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/FormatName$",NewQueue.FormatName
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/IsTransactional$",NewQueue.IsTransactional
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/Label$",NewQueue.Label
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/PrivilegeLevel$",NewQueue.PrivilegeLevel
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/Quota$",NewQueue.Quota
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/JournalEnabled$",NewQueue.JournalEnabled
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/JournalQuota$",NewQueue.JournalQuota
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/ADsPath$",NewQueue.ADsPath
.AddProperty "$MPElement[Name='Microsoft.MSMQ.2008R2.Queue']/IsTestQueue$",NewQueue.IsTestQueue
End With
Call oDiscoveryData.AddInstance(oInstance)
End Sub
Sub WriteDetailEvent(NewQueue)
Dim sMessage
sMessage = "PrincipalName: " & NewQueue.ComputerName & VbCrLf & _
"Public: " & NewQueue.IsPublic & VbCrLf & _
"PathName: " & NewQueue.PathName & VbCrLf & _
"ADsPath: " & NewQueue.ADsPath & VbCrLf & _
"Format Name: " & NewQueue.FormatName & VbCrLf & _
"IsTransactional: " & NewQueue.IsTransactional & VbCrLf & _
"Label: " & NewQueue.Label & VbCrLf & _
"PrivilegeLevel: " & NewQueue.PrivilegeLevel
Call LogDetail(EVENTNO_FOUND_QUEUE,sMessage)
End Sub
Sub WriteQueueToRegistry(NewQueue,Computer)
Dim oReg, sRegRoot
Set oReg=GetObject("winmgmts:\\" & Computer & "\root\default:StdRegProv")
If NewQueue.IsPublic = True Then
sRegRoot = MSMQ_REGROOT & "\" & Computer & "\" & PUBLICQUEUE_VALUENAME & "\" & NewQueue.Label
oReg.CreateKey HKEY_LOCAL_MACHINE,sRegRoot
oReg.SetStringValue HKEY_LOCAL_MACHINE,sRegRoot,"PathName",NewQueue.PathName
oReg.SetStringValue HKEY_LOCAL_MACHINE,sRegRoot,"FormatName",NewQueue.FormatName
oReg.SetStringValue HKEY_LOCAL_MACHINE,sRegRoot,"Quota",NewQueue.Quota
oReg.SetStringValue HKEY_LOCAL_MACHINE,sRegRoot,"JournalEnabled",NewQueue.JournalEnabled
oReg.SetStringValue HKEY_LOCAL_MACHINE,sRegRoot,"JournalQuota",NewQueue.JournalQuota
End If
End Sub
Sub InitializeRegistry(Computer,KeyPath,ValueName)
Dim oReg
Set oReg=GetObject("winmgmts:\\" & Computer & "\root\default:StdRegProv")
oReg.CreateKey HKEY_LOCAL_MACHINE,KeyPath
oReg.CreateKey HKEY_LOCAL_MACHINE,KeyPath & "\" & Computer
oReg.CreateKey HKEY_LOCAL_MACHINE,KeyPath & "\" & Computer & "\" & PUBLICQUEUE_VALUENAME
End Sub
Sub AddToPublicQueuesRegistry(Computer,KeyPath,ValueName,Value)
Dim oReg, sValue, i
Set oReg=GetObject("winmgmts:\\" & Computer & "\root\default:StdRegProv")
Call oReg.GetMultiStringValue(HKEY_LOCAL_MACHINE,KeyPath,ValueName,aValues)
i = 0
For Each sValue In aValues
ReDim Preserve aNewValues(i)
aNewValues(i) = sValue
i=i+1
Next
ReDim Preserve aNewValues(i)
aNewValues(i) = Value
Call oReg.SetMultiStringValue(HKEY_LOCAL_MACHINE,KeyPath,ValueName,aNewValues)
End Sub
Sub ThrowScriptError(EventNo,Severity,Message,Abort)
Message = 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 IsMSMQServiceRunning()
Dim WMI, Services, Service
Set WMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Set Services = WMI.ExecQuery("select * from win32_service where name = '" & sServiceName & "'")
For Each Service In Services
If lcase(Service.State) = "running" Then
IsMSMQServiceRunning = True
Else
IsMSMQServiceRunning = False
End If
Next
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: