Article ID: 901051
Article Last Modified on 1/26/2007
APPLIES TO
- Microsoft Operations Manager (MOM) 2005
SYMPTOMS
When 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:
Additionally, the following MOM Active Directory Management Pack reports may contain no data:
- AD Domain Changes
- AD Domain Controllers
- 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. Additionally, the following reports return no data in a pure Windows 2000 forest:
- AD Machine Account Authentication Failures
- AD Replication Site links
CAUSE
This 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.
RESOLUTION
To 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 information
To 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.
STATUS
Microsoft has confirmed that this is a problem in the Microsoft products that are listed in the "Applies to" section.
Keywords: kbtshoot kbprb KB901051