Errors occur after you install the Microsoft Operations Manager 2005 Active Directory Management Pack in a Windows 2000 forest (901051)
The information in this article applies to:
- Microsoft Operations Manager 2005
SYMPTOMSWhen you use the Active Directory Management Pack for Microsoft Operations Manager (MOM) 2005 to monitor a native Microsoft Windows 2000 Active Directory environment, you may receive an alert in the MOM Operator console that resembles the following: An error occurred while executing 'AD Topology Discovery'
The query '<LDAP://contoso.com/CN=Configuration,DC=contoso,DC=com>(&(objectCategory=crossRef)(!(|(cn=Enterprise Schema)(cn=Enterprise Configuration))));ncName,dnsRoot,msDS-NC-Replica-Locations;subtree' failed to execute.
The error returned was: 'Unspecified error' (0x80004005)
0x80004005
Additionally, the following MOM Active Directory Management Pack reports may contain no data: - AD Domain Changes
- AD Domain Controllers
- AD Machine Account Authentication Failures
- AD Replication Connection Objects
- AD Replication Latency Report
- AD Role Holders
- AD DC Disk Space Chart
- DC Replication BW
Note The DC Replication subreport may also contain no data.
CAUSEThis problem occurs when you use MOM 2005 together with version 05.0.2642.0063 of the Active Directory Management Pack to monitor a forest of Windows 2000-based domain controllers. In this scenario, the AD Topology Discovery script may fail because of a dependency on an attribute that exists only in a Microsoft Windows Server 2003 Active Directory environment.RESOLUTIONTo resolve this problem, install the following ADTopologyScriptNew.txt script. This updated version of the AD Topology Discovery script removes a dependency on Microsoft Windows Server 2003. Therefore, the script can run successfully in a native Windows 2000 environment. To install the script, follow the steps in the "Script installation information" section that follows the script. ADTopologyScriptNew.txt'*************************************************************************
' Script Name - AD Topology Discovery
'
' Purpose - Discovers the AD Replication Topology and writes it to the
' MOM database
'
' Parameters - LogSuccessEvent - True/False value to indicates to log an
' an event for script success
' (useful for demos and debugging)
'
' (c) Copyright 2003, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Option Explicit
'Event Constants
Const EVENT_TYPE_SUCCESS = 0
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4
' Event ID Constants
Const EVENT_ID_INVALID_PARAM = 20066
Const EVENT_ID_SCRIPT_ERROR = 21000
Const EVENT_ID_SUCCESS = 20099
Const EVENT_ID_NOT_AN_EVENT = 20002
Const EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE = 24000
Const EVENT_ID_AGENTLESS = 20098
' Other Constants
Const SCRIPT_NAME = "AD Topology Discovery"
Const E_INVALIDARG = &H80070057
Class Error
Public Description
Public Number
Public Source
Sub Init(oErr)
Description = oErr.Description
Number = oErr.Number
Source = oErr.Source
End Sub
Sub Raise(strDescription)
Err.number = Number
Err.Description = Description
Err.Raise Number, Source, strDescription & GetErrorString(Err)
End Sub
End Class
Dim oError
Set oError = new Error
On Error Resume Next
If Not(ScriptContext.IsTargetAgentless) Then
DoADDiscovery
If Err <> 0 Then
CreateEvent EVENT_ID_SCRIPT_ERROR, _
EVENT_TYPE_WARNING, _
"An error occurred while executing '" & SCRIPT_NAME & "'" & _
vbCrLf & Err.Description & vbCrLf & "0x" & Hex(Err.number)
End If
Else
CreateEvent EVENT_ID_AGENTLESS, EVENT_TYPE_ERROR, "The AD Management Pack does not support the agentless management mode." & vbCrLf & _
"The script '" & SCRIPT_NAME & "' will not execute." & vbCrLf & _
"To prevent this alert being generated again, either change the monitoring " & _
"mode of the computer '" & ScriptContext.TargetFQDNComputer & "' to agent-managed " & _
"or disable the rule that generated this alert."
End If
' Globals access throughout the script
Dim oADOConn, oRootDSE, oOOMADS
Sub DoADDiscovery()
On Error Resume Next
Dim dtStart
dtStart = Now
Dim oDiscData
Set oDiscData = ScriptContext.CreateDiscoveryData
oDiscData.ScopeID = "{69A2FFDA-8F08-415E-A609-B1F42F69B7EA}"
' Create the forests collection
Dim oForestsCollection
Set oForestsCollection = oDiscData.CreateCollection
oForestsCollection.ClassID = "Forest"
' Create the sites collection
Dim oSitesCollection
Set oSitesCollection = oDiscData.CreateCollection
oSitesCollection.ClassID = "Site"
oSitesCollection.AddScopeProperty "ISTG Role Holder"
oSitesCollection.AddScopeProperty "ISTG Enabled"
oSitesCollection.AddScopeProperty "Subnets"
' create collection for AD Site Link
Dim oSiteLinkCollection
Set oSiteLinkCollection = oDiscData.CreateCollection
oSiteLinkCollection.ClassID= "AD Site Link"
oSiteLinkCollection.AddScopeProperty "Replicates Every"
oSiteLinkCollection.AddScopeProperty "Transport"
oSiteLinkCollection.AddScopeProperty "Cost"
' create relationship collection for site to bridgehead
Dim oSiteBridgeheadCollection
Set oSiteBridgeheadCollection = oDiscData.CreateRelationshipCollection
oSiteBridgeheadCollection.TypeID= "Site-Bridgehead"
' create relationship Group to Computer
Dim oGroupToComputerCollection
Set oGroupToComputerCollection = oDiscData.CreateRelationshipCollection
oGroupToComputerCollection.TypeID= "Group-Computer"
oGroupToComputerCollection.SourceScopeFilter.AddKeyProperty "GroupName","Windows Domain Controllers"
' Create a GCs relationship collection with global scope
Dim oGCCollection
Set oGCCollection = oDiscData.CreateRelationshipCollection
oGCCollection.TypeID = "Computer-GC"
'Add the Forest instance collection to the discovery data packet
oDiscData.AddCollection oForestsCollection
'Add the Site instance collection to the discovery data packet
oDiscData.AddCollection oSitesCollection
'Add the SiteToSite Relationship collection to the discovery data packet
oDiscData.AddCollection oSiteLinkCollection
'Add the GroupToComputer Relationship collection to the discovery data packet
oDiscData.AddCollection oGroupToComputerCollection
' Add the collection containing the GC relationships
oDiscData.AddCollection oGCCollection
Set oOOMADs = CreateObject("McActiveDir.ActiveDirectory")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to CreateObject 'OOMADs'."
End If
Set oADOConn = CreateObject("ADODB.Connection")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to CreateObject 'ADODB.Connection'."
Else
oADOConn.Provider = "ADSDsOObject"
oADOConn.Open "ADs Provider"
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to initialize the 'ADSDSOObject'."
Else
Set oRootDSE = GetObject("LDAP://RootDSE")
' Create a forest instance
Dim oForestInstance, strForestDNSRoot
strForestDNSRoot = Mid(oRootDSE.Get("rootDomainNamingContext"), 4)
strForestDNSRoot = Replace(strForestDNSRoot, ",DC=", ".")
Set oForestInstance = oForestsCollection.CreateInstance
oForestInstance.AddKeyProperty "ForestName", strForestDNSRoot
oForestsCollection.AddInstance oForestInstance
Dim rsMonitor, rsSites, strQuery
strQuery = "<LDAP://" & oRootDSE.Get("DnsHostName") & "/CN=Sites," & oRootDSE.Get("ConfigurationNamingContext") & ">;(objectCategory=site);cn,adspath,distinguishedName;subtree"
Set rsSites = oADOConn.Execute(strQuery)
if Err.number <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "The query '" & strQuery & "' failed to execute."
Else
While Not rsSites.EOF
Err.Clear
'create site instance
Dim oSiteInstance
Set oSiteInstance = oSitesCollection.CreateInstance
oSiteInstance.AddKeyProperty "SiteName", rsSites.fields("cn")
oSitesCollection.AddInstance oSiteInstance
' Create a collection to hold the relationships between this site and it's servers
Dim oSiteToDCCollection
Set oSiteToDCCollection = oDiscData.CreateRelationshipCollection
oSiteToDCCollection.TypeID = "Site-DC"
oSiteToDCCollection.SourceScopeFilter.AddKeyProperty "SiteName", rsSites.Fields("cn")
' Create a collection to hold the site to computer relationships
Dim oSitetoComputerCollection
Set oSitetoComputerCollection = oDiscData.CreateRelationshipCollection
oSitetoComputerCollection.TypeID = "Site-Computer"
oSitetoComputerCollection.SourceScopeFilter.AddKeyProperty "SiteName", rsSites.Fields("cn")
' Create a collection to hold the site to bridgehead relationships
Dim oSitetoBridgeheadCollection
Set oSitetoBridgeheadCollection = oDiscData.CreateRelationshipCollection
oSitetoBridgeheadCollection.TypeID = "Site-Bridgehead"
oSitetoBridgeheadCollection.SourceScopeFilter.AddKeyProperty "SiteName", rsSites.Fields("cn")
oSitetoBridgeheadCollection.AddScopeProperty "TransportType"
Err.Clear
' For each site, enumerate it's servers
strQuery = "<" & rsSites.Fields("adspath") & ">;(objectCategory=nTDSDSA);adspath;subtree"
Dim rsServers
Set rsServers = oADOConn.Execute(strQuery)
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"The query '" & strQuery & "' failed to execute." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
While Not rsServers.EOF
' From the ntdsasettings object, get it's parent which is the server object
' This should always work, but we don't really care if it does or not, we'll
' pick up any failure after attempting to get its parent.
Dim oNTDSASettings
Set oNTDSASettings = GetObject(rsServers.Fields("adspath"))
Err.Clear
Dim oServer
Set oServer = GetObject(oNTDSASettings.Parent)
If Err.Number = 0 Then
' Determine the flat domain name for the DC
Dim strFlatDomain
strFlatDomain = oOOMADs.GetFlatDomainForDC(oServer.Get("dnsHostName"))
'relate site to computer
Dim oSiteToComputerInstance
Set oSiteToComputerInstance = oSitetoComputerCollection.CreateInstance
oSiteToComputerInstance.TargetProperty.AddKeyProperty "ComputerName", strFlatDomain & "\" & oServer.Get("CN")
oSitetoComputerCollection.AddInstance oSiteToComputerInstance
'relate site to computer
Dim oSiteToDCInstance
Set oSiteToDCInstance = oSiteToDCCollection.CreateInstance
oSiteToDCInstance.TargetProperty.AddKeyProperty "ComputerName", strFlatDomain & "\" & oServer.Get("CN")
oSiteToDCInstance.TargetProperty.AddKeyProperty "DC Name", oServer.Get("CN")
oSiteToDCCollection.AddInstance oSiteToDCInstance
'Relationship "Computer" is a member of "Group"
Dim oGroupToComputerInstance
Set oGroupToComputerInstance = oGroupToComputerCollection.CreateInstance
oGroupToComputerInstance.TargetProperty.AddKeyProperty "ComputerName", strFlatDomain & "\" & oServer.Get("CN")
oGroupToComputerCollection.AddInstance oGroupToComputerInstance
' If the server is a preferred bridgehead server for the site,
' create a 'site-bridgehead' relationship and set the transport
' type on the relationship.
Dim arrBridgeheadTransports
arrBridgeheadTransports = oServer.GetEx("bridgeheadTransportList")
If IsArray(arrBridgeheadTransports) Then
Dim strTransportType
For Each strTransportType in arrBridgeheadTransports
Dim oSiteToBridgeheadInstance
Set oSiteToBridgeheadInstance = oSitetoBridgeheadCollection.CreateInstance
oSiteToBridgeheadInstance.TargetProperty.AddKeyProperty "ComputerName", strFlatDomain & "\" & oServer.Get("CN")
oSiteToBridgeheadInstance.AddProperty "TransportType", Mid(strTransportType, 4, Instr(strTransportType, ",") - 4)
oSitetoBridgeheadCollection.AddInstance oSiteToBridgeheadInstance
Next
End If
If IsGC(oNTDSASettings) Then
Dim oGCInstance
Set oGCInstance = oGCCollection.CreateInstance
oGCInstance.SourceProperty.AddKeyProperty "ComputerName", strFlatDomain & "\" & oServer.Get("CN")
oGCInstance.TargetProperty.AddKeyProperty "GC Name", strFlatDomain & "\" & oServer.Get("CN")
oGCCollection.AddInstance oGCInstance
End If
End If
rsServers.MoveNext
Wend
End If
Err.Clear
' Find all the subnets for the site
Dim rsSubnets
strQuery = "<LDAP://" & oRootDSE.Get("DnsHostName") & "/CN=Sites," & oRootDSE.Get("ConfigurationNamingContext") & ">;(&(objectCategory=subnet)(siteObject=" & rsSites.Fields("distinguishedName") & "));cn;subtree"
Set rsSubnets = oADOConn.Execute(strQuery)
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"The query '" & strQuery & "' failed to execute." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
oSiteInstance.AddProperty "Subnets", ""
Else
Dim strSubnets, iSubnetCount
iSubnetCount = 0
strSubnets = ""
'
' Only list 5 subnets, if we listed them all, we'd run out of
' space in the attribute.
'
While Not rsSubnets.EOF AND iSubnetCount <= 5
iSubnetCount = iSubnetCount + 1
If iSubnetCount <= 5 Then
strSubnets = strSubnets & vbCrLf & rsSubnets.Fields("cn")
Else
strSubnets = strSubnets & vbCrLf & "..."
End If
rsSubnets.MoveNext
Wend
oSiteInstance.AddProperty "Subnets", strSubnets
End If
Err.Clear
' Find the ISTG for the site.
Dim rsSiteSettings
strQuery = "<" & rsSites.Fields("adspath") & ">;(interSiteTopologyGenerator=*);interSiteTopologyGenerator,options;subtree"
Set rsSiteSettings = oADOConn.Execute(strQuery)
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"The query '" & strQuery & "' failed to execute." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
If Not rsSiteSettings.EOF Then
If rsSiteSettings.Fields("options") AND 1 THEN
oSiteInstance.AddProperty "ISTG Enabled", "No"
oSiteInstance.AddProperty "ISTG Role Holder", "None"
Else
oSiteInstance.AddProperty "ISTG Enabled", "Yes"
Dim oISTG
Set oISTG = GetObject("LDAP://" & rsSiteSettings.Fields("interSiteTopologyGenerator") )
If Err <> 0 Then
oSiteInstance.AddProperty "ISTG Role Holder", "Unknown"
Else
Dim oISTGServer
Set oISTGServer = GetObject(oISTG.Parent)
oSiteInstance.AddProperty "ISTG Role Holder", oISTGServer.Get("CN")
End If
End If
Else
oSiteInstance.AddProperty "ISTG Role Holder", "None"
oSiteInstance.AddProperty "ISTG Enabled", "Unknown"
End If
End If
' Add the site to bridgehead relationship collection to the discover data
oDiscData.AddCollection oSitetoBridgeheadCollection
' Add the site to computer relationship collection to the discover data
oDiscData.AddCollection oSitetoComputerCollection
' Add the site to DC relationship collection to the discover data
oDiscData.AddCollection oSiteToDCCollection
rsSites.MoveNext
Wend
End If
Err.Clear
Dim rsSiteLinks
strQuery = "<LDAP://" & oRootDSE.Get("DnsHostName") & "/CN=Inter-site Transports,CN=Sites," & oRootDSE.Get("ConfigurationNamingContext") & ">;(objectCategory=siteLink);cn,cost,siteList,replInterval,adspath,schedule,isDeleted;subtree"
Set rsSiteLinks = oADOConn.Execute(strQuery)
if Err.number <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "The query '" & strQuery & "' failed to execute."
Else
While NOT rsSiteLinks.EOF
Dim oTransport, strTransport
Dim bDeleted
bDeleted = rsSiteLinks.Fields("isDeleted")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
Dim strSiteLinkPath
strSiteLinkPath = rsSiteLinks.Fields("adspath")
oError.Raise "Failed to determine if object '" & strSiteLinkPath & "' is deleted."
Else
If IsNull(bDeleted) Or bDeleted = False Then
Set oTransport = GetObject(rsSiteLinks.Fields("adspath"))
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get object '" & rsSiteLinks.Fields("adspath") & "'."
strTransport = "Unknown"
Err.Clear
Else
Set oTransport = GetObject(oTransport.Parent)
strTransport = oTransport.Get("cn")
End If
Dim oSiteLinkInstance
Set oSiteLinkInstance = oSiteLinkCollection.CreateInstance
oSiteLinkInstance.AddKeyProperty "Site Link Name", rsSiteLinks.Fields("cn")
oSiteLinkInstance.AddProperty "Replicates Every", rsSiteLinks.Fields("replInterval")
oSiteLinkInstance.AddProperty "Transport", strTransport
oSiteLinkInstance.AddProperty "Cost", rsSiteLinks.Fields("cost")
oSiteLinkCollection.AddInstance oSiteLinkInstance
' create relationship collection for site link to site
Dim oSiteLinkToSiteCollection
Set oSiteLinkToSiteCollection = oDiscData.CreateRelationshipCollection
oSiteLinkToSiteCollection.TypeID= "Site-AD Site Link"
oSiteLinkToSiteCollection.TargetScopeFilter.AddKeyProperty "Site Link Name", rsSiteLinks.Fields("cn")
oDiscData.AddCollection oSiteLinkToSiteCollection
If IsArray(rsSiteLinks.Fields("siteList")) Then
Dim arrSites, strSite, strSite2
arrSites = rsSiteLinks.Fields("siteList")
Dim i, j
For i = LBound(arrSites) To UBound(arrSites)
strSite = arrSites(i)
Dim oSiteLinkToSiteInstance
Set oSiteLinkToSiteInstance = oSiteLinkToSiteCollection.CreateInstance
oSiteLinkToSiteInstance.SourceProperty.AddKeyProperty "SiteName", Mid(strSite, 4, Instr(strSite, ",") - 4)
oSiteLinkToSiteCollection.AddInstance oSiteLinkToSiteInstance
Next
End If
End If
End If
rsSiteLinks.MoveNext
Wend
if Err.number <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to discovery topology correctly."
End If
End If
Err.Clear
Dim rsNamingContexts
strQuery = "<LDAP://" & oRootDSE.Get("DnsHostName") & "/" & oRootDSE.Get("ConfigurationNamingContext") & ">;(&(objectCategory=crossRef)(!(|(cn=Enterprise Schema)(cn=Enterprise Configuration))));ncName,dnsRoot;subtree"
Set rsNamingContexts = oADOConn.Execute(strQuery)
If Err.number <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "The query '" & strQuery & "' failed to execute."
Else
' Create a collection to hold all the naming contexts
Dim oNCCollection
Set oNCCollection = oDiscData.CreateCollection
oNCCollection.ClassID = "Naming Context"
oNCCollection.AddScopeProperty "DNSRoot"
oNCCollection.AddScopeProperty "ApplicationPartition"
oDiscData.AddCollection oNCCollection
While Not rsNamingContexts.EOF
Dim oNCInstance
Set oNCInstance = oNCCollection.CreateInstance
oNCInstance.AddKeyProperty "NCName", rsNamingContexts.Fields("ncName")
Dim arrDNSRoots
arrDNSRoots = rsNamingContexts.Fields("DNSRoot").Value
If IsArray(arrDNSRoots) Then
oNCInstance.AddProperty "DNSRoot", arrDNSRoots(0)
End If
Dim bIsNDNC
bIsNDNC = False
' Bind to the object to attempt to get the msDS-NC-Replica-Locations attribute.
' W2K doesn't support this attribute, so if we ask for it in the query, an error
' would be raised in W2K forests.
Dim oNamingContext
Set oNamingContext = GetObject(rsNamingContexts.Fields("adspath"))
If IsObject(oNamingContext) Then
If IsNull(oNamingContext.Get("msDS-NC-Replica-Locations")) Then
oNCInstance.AddProperty "ApplicationPartition", "False"
Else
oNCInstance.AddProperty "ApplicationPartition", "True"
bIsNDNC = True
End If
End If
oNCCollection.AddInstance oNCInstance
' Find the FSMO role holders for each NC
If IsArray(arrDNSRoots) Then
oOOMADs.Domain = arrDNSRoots(0)
Dim strMaster
Err.Clear
' NDNCs don't have a RID master or PDC so don't try to discover them
If Not(bIsNDNC) Then
Dim oMasterCollection
Set oMasterCollection = oDiscData.CreateRelationshipCollection
oMasterCollection.TypeID = "RID-NamingContext"
oMasterCollection.TargetScopeFilter.AddKeyProperty "NCName", rsNamingContexts.Fields("ncName")
strMaster = oOOMADS.RIDMaster
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the RID Master for the domain '" & _
arrDNSRoots(0) & "'." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
AddSourceInstanceToCollection oMasterCollection, strMaster
End If
oDiscData.AddCollection oMasterCollection
Err.Clear
Set oMasterCollection = oDiscData.CreateRelationshipCollection
oMasterCollection.TypeID = "PDC-NamingContext"
oMasterCollection.TargetScopeFilter.AddKeyProperty "NCName", rsNamingContexts.Fields("ncName")
strMaster = oOOMADS.PDCMaster
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the PDC Master for the domain '" & _
arrDNSRoots(0) & "'." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
AddSourceInstanceToCollection oMasterCollection, strMaster
End If
oDiscData.AddCollection oMasterCollection
End If
Err.Clear
Set oMasterCollection = oDiscData.CreateRelationshipCollection
oMasterCollection.TypeID = "Infrastructure-NamingContext"
oMasterCollection.TargetScopeFilter.AddKeyProperty "NCName", rsNamingContexts.Fields("ncName")
strMaster = GetInfrastructureMasterUsingWellKnownGUID(arrDNSRoots(0), rsNamingContexts.Fields("ncName").Value)
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the Infrastructure Master for the domain '" & _
arrDNSRoots(0) & "'." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
AddSourceInstanceToCollection oMasterCollection, strMaster
End If
oDiscData.AddCollection oMasterCollection
End If
rsNamingContexts.MoveNext
Wend
End If
End If
oOOMADs.Domain = ""
Err.Clear
' Create the schema master and domain naming master instances
Set oMasterCollection = oDiscData.CreateRelationshipCollection
oMasterCollection.TypeID = "Computer-DomainNamingMaster"
strMaster = oOOMADS.DomainNamingMaster
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the Domain Naming Master." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
AddComputerRelationshipToCollection oMasterCollection, strMaster, "DomainNamingMasterName"
oDiscData.AddCollection oMasterCollection
End If
Set oMasterCollection = oDiscData.CreateRelationshipCollection
oMasterCollection.TypeID = "Computer-SchemaMaster"
strMaster = oOOMADS.SchemaMaster
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the Schema Master." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
AddComputerRelationshipToCollection oMasterCollection, strMaster, "SchemaMasterName"
oDiscData.AddCollection oMasterCollection
End If
End If
ScriptContext.Submit oDiscData
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to submit discovery data."
End If
ScriptContext.Echo "AD Discovery took " & DateDiff("s", dtStart, Now) & " seconds to complete"
End Sub
'******************************************************************************
Sub AddSourceInstanceToCollection(oCollection, strSource)
'
' Purpose: Creates an instance of a relationship and set's the computer
' name to that of the source, and adds it to the collection.
'
' Parameters: oCollection - the collection to add the instance to
' strSource - the source to add to the collection
'
' Return: None
'
On Error Resume Next
Dim strFlatDomainName, strFlatComputerName
strFlatDomainName = GetFlatDomainForDC(strSource)
If Err = 0 Then
strFlatComputerName = oOOMADs.GetFlatComputerName(strSource)
End If
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the flat names for the computer '" & strSource & "'." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
Dim oInstance
Set oInstance = oCollection.CreateInstance
oInstance.SourceProperty.AddKeyProperty "ComputerName", strFlatDomainName & "\" & strFlatComputerName
oCollection.AddInstance oInstance
End If
End Sub
'******************************************************************************
Sub AddComputerRelationshipToCollection(oCollection, strInstance, strTargetKeyName)
'
' Purpose: Creates an instance of a computer relationship and set's the
' computer name as the source of the relationship and the
' target name to the target of the relationship
'
' Parameters: oCollection - the collection to add the instance to
' strInstance - the instance to add to the collection
' strTargetKeyName - the name of the key value on the target
'
' Return: None
'
On Error Resume Next
Dim strFlatDomainName, strFlatComputerName
strFlatDomainName = GetFlatDomainForDC(strInstance)
If Err = 0 Then
strFlatComputerName = oOOMADs.GetFlatComputerName(strInstance)
End If
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the flat names for the computer '" & strInstance & "'." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
Dim oRelationship
Set oRelationship = oCollection.CreateInstance
oRelationship.SourceProperty.AddKeyProperty "ComputerName", strFlatDomainName & "\" & strFlatComputerName
oRelationship.TargetProperty.AddKeyProperty strTargetKeyName, strFlatDomainName & "\" & strFlatComputerName
oCollection.AddInstance oRelationship
End If
End Sub
'******************************************************************************
Function IsGC(oNTDSASettings)
'
' Purpose: Determines whether the NTDSASettings object passed in belongs
' to a GC
'
' Parameters: oNTDSASettings - the object to check
'
' Return: Bool, True if it is a GC, False otherwise
'
On Error Resume Next
IsGC = False
' Check whether the DC is a GC
Dim rsGCs, strGUID, strQuery
' Reformat the GUID so it's the right format for what we want to do
strGUID = ReformatGUID(oNTDSASettings.GUID)
strQuery = "<LDAP://" & oRootDSE.Get("DnsHostName") & "/<GUID=" & strGUID & ">>;(&(objectCategory=nTDSDSA)(options:1.2.840.113556.1.4.803:=1));adspath,cn;base"
Set rsGCs = oADOConn.Execute(strQuery)
If Err <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"The query '" & strQuery & "' failed to execute." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
If Not rsGCs.EOF Then
' It is a GC
IsGC = True
End If
End If
End Function
'******************************************************************************
Function ReformatGUID(strOrigGUID)
'
' Purpose: Reformats an obj.GUID into a format that's useful in queries.
'
' Parameters: strOrigGUID - the original format of the GUID
'
' Return: String, the reformatted GUID
'
If Len(strOrigGUID) <> 32 Then
Err.Raise &H80070057, SCRIPT_NAME & "::ReformatGUID", "Invalid Argument"
End If
ReformatGUID = Mid(strOrigGUID, 7, 2) & Mid(strOrigGUID, 5, 2) & Mid(strOrigGUID, 3, 2) & Mid(strOrigGUID, 1, 2)
ReformatGUID = ReformatGUID & "-"
ReformatGUID = ReformatGUID & Mid(strOrigGUID, 11, 2) & Mid(strOrigGUID, 9, 2)
ReformatGUID = ReformatGUID & "-"
ReformatGUID = ReformatGUID & Mid(strOrigGUID, 15, 2) & Mid(strOrigGUID, 13, 2)
ReformatGUID = ReformatGUID & "-"
ReformatGUID = ReformatGUID & Mid(strOrigGUID, 17, 4)
ReformatGUID = ReformatGUID & "-"
ReformatGUID = ReformatGUID & Mid(strOrigGUID, 21, 12)
End Function
'******************************************************************************
Sub CreateEvent(lngEventID, lngEventType, strMessage)
'
' Purpose: Creates a MOM event
'
' Parameters: lngEventID, the ID for the event
' lngEventType, the severity for the event. See constants at head of file
' strMessage, the message for the event
'
' Return: nothing
'
On Error Resume Next
Dim objNewEvent
' Create a new event
Set objNewEvent = ScriptContext.CreateEvent
' Set event properties
objNewEvent.Message = strMessage
objNewEvent.EventNumber = lngEventID
objNewEvent.EventType = lngEventType
' Submit the event
ScriptContext.Submit objNewEvent
Set objNewEvent = Nothing
End Sub
'******************************************************************************
Function GetErrorString(oErr)
'
' Purpose: Attempts to find the description for an error if an error with
' no description is passed in.
'
' Parameters: oErr, the error object
'
' Return: String, the description for the error. (Includes the error code.)
'
Dim lErr, strErr
lErr = oErr
strErr = oErr.Description
On Error Resume Next
If 0 >= Len(strErr) Then
' If we don't have an error description, then check to see if the error
' is a 0x8007xxxx error. If it is, then look it up.
Const ErrorMask = &HFFFF0000
Const HiWord8007 = &H80070000
Const LoWordMask = 65535 ' This is equivalent to 0x0000FFFF
If (lErr And ErrorMask) = HiWord8007 Then
' Attempt to use 'net helpmsg' to get a description for the error.
Dim oShell
Set oShell = CreateObject("WScript.Shell")
If Err = 0 Then
Dim oExec
Set oExec = oShell.Exec("net helpmsg " & (lErr And LoWordMask))
Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i < 5)
strErr = strMessage
End If
End If
End If
GetErrorString = vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
Function GetUTCOffset()
'
' Purpose: To get the difference between UTC and local time
'
' Arguments: None
'
' Returns: The number of hours between UTC and local time
'
Dim oSet, oOS, lTZOffset
Set oSet = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
For Each oOS In oSet
lTZOffset = oOS.CurrentTimeZone
Next
' Convert from number of minutes to number of hours
GetUTCOffset = lTZOffset / 60
End Function
'******************************************************************************
Function GetInfrastructureMasterUsingWellKnownGUID(strDNSHost, strNCDN)
'
' Purpose: Finds (if available) the infrastructure role master in the naming
' context identified by strRoot.
'
' Arguments: strNCDN, the DN of the naming context to look in
'
' Returns: Object, either the ADSI object representing the infrastructure
' role master or NULL
'
' Remarks: Any error encountered will cause the method to throw an
' exception. This must be handled by the caller.
' This method does 3 binds. In a slow system this may take
' some time.
'
On Error Resume Next
Dim oContainer, oNTDS, oMaster, lErr, strErr, strSource, strLDAPSearchComputer
strLDAPSearchComputer = "LDAP://" & strDNSHost & "/"
Set oContainer = GetObject(strLDAPSearchComputer & "<WKGUID=2fbac1870ade11d297c400c04fd8d5cd," & strNCDN & ">")
If Err <> 0 Then
lErr = Err.number
strErr = "Failed to bind to '" & strLDAPSearchComputer & _
"<WKGUID=2fbac1870ade11d297c400c04fd8d5cd," & _
strNCDN & ">'." & GetErrorString(Err)
On Error Goto 0
Err.Raise lErr, "GetInfrastructureMasterUsingWellKnownGUID", strErr
End If
Set oNTDS = GetObject(strLDAPSearchComputer & oContainer.Get("fSMORoleOwner"))
If Err <> 0 Then
lErr = Err.number
strErr = "Failed to get the 'fSMORoleOwner' attribute from the object '" & _
strLDAPSearchComputer & "<WKGUID=2fbac1870ade11d297c400c04fd8d5cd," & _
strNCDN & ">'." & GetErrorString(Err)
On Error Goto 0
Err.Raise lErr, "GetInfrastructureMasterUsingWellKnownGUID", strErr
End If
Set oMaster = GetObject(oNTDS.Parent)
If Err <> 0 Then
lErr = Err.number
strErr = "Failed to get the object '" & oNTDS.Parent & "'." & GetErrorString(Err)
On Error Goto 0
Err.Raise lErr, "GetInfrastructureMasterUsingWellKnownGUID", strErr
End If
GetInfrastructureMasterUsingWellKnownGUID = oMaster.Get("dnsHostName")
If Err <> 0 Then
lErr = Err.number
strErr = "Failed to get the dnsHostName attribute of '" & oNTDS.Parent & "'." & GetErrorString(Err)
On Error Goto 0
Err.Raise lErr, "GetInfrastructureMasterUsingWellKnownGUID", strErr
End If
End Function
'******************************************************************************
Function GetFlatDomainForDC(strDNSHostName)
'
' Purpose: To obtain the flat (netbios) domain name for a DC
'
' Arguments: strDNSHostName - the DCs DNS name
'
' Returns: String, the flat domain name
'
On Error Resume Next
' Search for the Server object with the DNSHostName = strDNSHostName
' Use it's ServerReference to work out what domain it's in.
' Get the domain partition object.
' If the Netbios attribute is filled in, get that, otherwise use
' the top level DNS name.
Dim strQuery
strQuery = "<LDAP://" & oRootDSE.Get("DnsHostName") & "/" & oRootDSE.Get("ConfigurationNamingContext") & ">;(&(objectCategory=Server)(dnsHostName=" & strDNSHostName & "));serverReference,distinguishedName;subtree"
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to construct the query to find the Server '" & strDNSHostName & "'."
End If
Dim rsServers
Set rsServers = oADOConn.Execute(strQuery)
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query to find the Server '" & strDNSHostName & "'."
End If
Do Until rsServers.EOF or Len(GetFlatDomainForDC) > 0
Dim strDomainDN, strServerRef, iStartDomain
strServerRef = rsServers.Fields("ServerReference")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get the ServerReference attribute of '" & strDNSHostName & "'."
End If
iStartDomain = Instr(strServerRef, "DC=")
If iStartDomain > 0 Then
strDomainDN = Mid(strServerRef, iStartDomain)
strQuery = "<LDAP://" & oRootDSE.Get("DnsHostName") & "/" & oRootDSE.Get("ConfigurationNamingContext") & ">;(&(objectCategory=crossRef)(ncName=" & strDomainDN & "));netbiosName,dnsRoot;subtree"
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to construct the query to find the Domain '" & strDomainDN & "'."
End If
Dim rsDomains
Set rsDomains = oADOConn.Execute(strQuery)
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query to find the Domain '" & strDomainDN & "'."
End If
Do Until rsDomains.EOF or Len(GetFlatDomainForDC) > 0
Dim strFlatName
strFlatName = rsDomains.Fields("netbiosName")
If Err <> 0 Or Len(strFlatName) = 0 Then
Dim arrDNSRoots
arrDNSRoots = rsDomains.Fields("dnsRoot")
If IsArray(arrDNSRoots) Then
strFlatName = arrDNSRoots(0)
ElseIf IsString(arrDNSRoots) Then
strFlatName = arrDNSRoots
End If
Dim iEndTopLevel
iEndTopLevel = Instr(strFlatName, ".")
If iEndTopLevel > 0 Then
strFlatName = Left(strFlatName, iEndTopLevel -1)
End If
End If
GetFlatDomainForDC = strFlatName
rsDomains.MoveNext
Loop
End If
rsServers.MoveNext
Loop
If Len(GetFlatDomainForDC) = 0 Then
On Error Goto 0
Err.Raise E_INVALIDARG, SCRIPT_NAME & "::GetFlatDomainForDC", "Failed to obtain the flat domain name for '" & strDNSHostName & "'."
End If
End Function
Script installation informationTo install this script, follow these steps: - Start the MOM 2005 Administrator console.
- Expand Microsoft Operations Manager (ServerName), expand Management Packs, expand Rule Groups, expand Microsoft Windows Active Directory, expand Replication Topology Discovery (Site Links), and then click Event Rules.
- Open the Script - AD Topology Discovery script.
-
Click the Responses tab.
- In the Response list, click Script - AD Topology Discovery, and then click Edit.
-
In the Launch a Script dialog box, click Edit.
-
Click the Script tab.
-
Copy the contents of the script into a text file as a backup copy of the original script, and then delete the contents of the Specify the JScript source code for the script box.
- Paste the contents of the ADTopologyScriptNew.txt file into the Specify the JScript source code for the script box.
- Click OK three times to exit all the open dialog boxes.
STATUSMicrosoft has confirmed that this is a problem in the Microsoft products that are listed in the "Applies to" section.
| Modification Type: | Major | Last Reviewed: | 7/31/2006 |
|---|
| Keywords: | kbtshoot kbprb KB901051 kbAudITPRO |
|---|
|