Microsoft KB Archive/901051: Difference between revisions

From BetaArchive Wiki
m (Text replacement - ">" to ">")
m (Text replacement - "&" to "&")
 
Line 47: Line 47:
<div class="errormessage">
<div class="errormessage">


An error occurred while executing 'AD Topology Discovery' The query '<LDAP://contoso.com/CN=Configuration,DC=contoso,DC=com>(&amp;(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
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


</div>
</div>
Line 113: Line 113:
' Other Constants
' Other Constants
Const SCRIPT_NAME = &quot;AD Topology Discovery&quot;
Const SCRIPT_NAME = &quot;AD Topology Discovery&quot;
Const E_INVALIDARG = &amp;H80070057
Const E_INVALIDARG = &H80070057


Class Error
Class Error
Line 129: Line 129:
     Err.number = Number
     Err.number = Number
     Err.Description = Description
     Err.Description = Description
     Err.Raise Number, Source, strDescription &amp; GetErrorString(Err)
     Err.Raise Number, Source, strDescription & GetErrorString(Err)
   End Sub
   End Sub
End Class
End Class
Line 143: Line 143:
         CreateEvent EVENT_ID_SCRIPT_ERROR, _
         CreateEvent EVENT_ID_SCRIPT_ERROR, _
                     EVENT_TYPE_WARNING, _
                     EVENT_TYPE_WARNING, _
                     &quot;An error occurred while executing '&quot; &amp; SCRIPT_NAME &amp; &quot;'&quot; &amp; _
                     &quot;An error occurred while executing '&quot; & SCRIPT_NAME & &quot;'&quot; & _
                     vbCrLf &amp; Err.Description &amp; vbCrLf &amp; &quot;0x&quot; &amp; Hex(Err.number)
                     vbCrLf & Err.Description & vbCrLf & &quot;0x&quot; & Hex(Err.number)
     End If
     End If
Else
Else
       CreateEvent EVENT_ID_AGENTLESS, EVENT_TYPE_ERROR, &quot;The AD Management Pack does not support the agentless management mode.&quot; &amp; vbCrLf &amp; _
       CreateEvent EVENT_ID_AGENTLESS, EVENT_TYPE_ERROR, &quot;The AD Management Pack does not support the agentless management mode.&quot; & vbCrLf & _
                                                         &quot;The script '&quot; &amp; SCRIPT_NAME &amp; &quot;' will not execute.&quot; &amp; vbCrLf &amp; _
                                                         &quot;The script '&quot; & SCRIPT_NAME & &quot;' will not execute.&quot; & vbCrLf & _
                                                         &quot;To prevent this alert being generated again, either change the monitoring &quot; &amp; _
                                                         &quot;To prevent this alert being generated again, either change the monitoring &quot; & _
                                                         &quot;mode of the computer '&quot; &amp; ScriptContext.TargetFQDNComputer &amp; &quot;' to agent-managed &quot; &amp; _
                                                         &quot;mode of the computer '&quot; & ScriptContext.TargetFQDNComputer & &quot;' to agent-managed &quot; & _
                                                         &quot;or disable the rule that generated this alert.&quot;
                                                         &quot;or disable the rule that generated this alert.&quot;
End If
End If
Line 250: Line 250:
        
        
         Dim rsMonitor, rsSites, strQuery
         Dim rsMonitor, rsSites, strQuery
         strQuery = &quot;<LDAP://&quot; &amp; oRootDSE.Get(&quot;DnsHostName&quot;) &amp; &quot;/CN=Sites,&quot; &amp; oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) &amp; &quot;>;(objectCategory=site);cn,adspath,distinguishedName;subtree&quot;
         strQuery = &quot;<LDAP://&quot; & oRootDSE.Get(&quot;DnsHostName&quot;) & &quot;/CN=Sites,&quot; & oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) & &quot;>;(objectCategory=site);cn,adspath,distinguishedName;subtree&quot;
         Set rsSites = oADOConn.Execute(strQuery)
         Set rsSites = oADOConn.Execute(strQuery)
         if Err.number <> 0 Then
         if Err.number <> 0 Then
           oError.Init(Err)
           oError.Init(Err)
           On Error Goto 0
           On Error Goto 0
           oError.Raise &quot;The query '&quot; &amp; strQuery &amp; &quot;' failed to execute.&quot;
           oError.Raise &quot;The query '&quot; & strQuery & &quot;' failed to execute.&quot;
         Else
         Else
           While Not rsSites.EOF
           While Not rsSites.EOF
Line 288: Line 288:


             ' For each site, enumerate it's servers
             ' For each site, enumerate it's servers
             strQuery = &quot;<&quot; &amp; rsSites.Fields(&quot;adspath&quot;) &amp; &quot;>;(objectCategory=nTDSDSA);adspath;subtree&quot;
             strQuery = &quot;<&quot; & rsSites.Fields(&quot;adspath&quot;) & &quot;>;(objectCategory=nTDSDSA);adspath;subtree&quot;
             Dim rsServers
             Dim rsServers
             Set rsServers = oADOConn.Execute(strQuery)
             Set rsServers = oADOConn.Execute(strQuery)
Line 294: Line 294:
               CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
               CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                           EVENT_TYPE_WARNING, _
                           EVENT_TYPE_WARNING, _
                           &quot;The query '&quot; &amp; strQuery &amp; &quot;' failed to execute.&quot; &amp; vbCrLf &amp; _
                           &quot;The query '&quot; & strQuery & &quot;' failed to execute.&quot; & vbCrLf & _
                           &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                           &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                           &quot;The error returned was:&quot; &amp; _
                           &quot;The error returned was:&quot; & _
                           vbCrLf &amp; GetErrorString(Err)
                           vbCrLf & GetErrorString(Err)
             Else
             Else
               While Not rsServers.EOF
               While Not rsServers.EOF
Line 319: Line 319:
                   Dim oSiteToComputerInstance  
                   Dim oSiteToComputerInstance  
                   Set oSiteToComputerInstance = oSitetoComputerCollection.CreateInstance
                   Set oSiteToComputerInstance = oSitetoComputerCollection.CreateInstance
                   oSiteToComputerInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain &amp; &quot;\&quot; &amp; oServer.Get(&quot;CN&quot;)
                   oSiteToComputerInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain & &quot;\&quot; & oServer.Get(&quot;CN&quot;)
                   oSitetoComputerCollection.AddInstance oSiteToComputerInstance
                   oSitetoComputerCollection.AddInstance oSiteToComputerInstance
                    
                    
Line 325: Line 325:
                   Dim oSiteToDCInstance
                   Dim oSiteToDCInstance
                   Set oSiteToDCInstance = oSiteToDCCollection.CreateInstance
                   Set oSiteToDCInstance = oSiteToDCCollection.CreateInstance
                   oSiteToDCInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain &amp; &quot;\&quot; &amp; oServer.Get(&quot;CN&quot;)
                   oSiteToDCInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain & &quot;\&quot; & oServer.Get(&quot;CN&quot;)
                   oSiteToDCInstance.TargetProperty.AddKeyProperty &quot;DC Name&quot;, oServer.Get(&quot;CN&quot;)
                   oSiteToDCInstance.TargetProperty.AddKeyProperty &quot;DC Name&quot;, oServer.Get(&quot;CN&quot;)
                   oSiteToDCCollection.AddInstance oSiteToDCInstance
                   oSiteToDCCollection.AddInstance oSiteToDCInstance
Line 332: Line 332:
                   Dim oGroupToComputerInstance
                   Dim oGroupToComputerInstance
                   Set oGroupToComputerInstance = oGroupToComputerCollection.CreateInstance
                   Set oGroupToComputerInstance = oGroupToComputerCollection.CreateInstance
                   oGroupToComputerInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain &amp; &quot;\&quot; &amp; oServer.Get(&quot;CN&quot;)
                   oGroupToComputerInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain & &quot;\&quot; & oServer.Get(&quot;CN&quot;)
                   oGroupToComputerCollection.AddInstance oGroupToComputerInstance
                   oGroupToComputerCollection.AddInstance oGroupToComputerInstance
                    
                    
Line 345: Line 345:
                       Dim oSiteToBridgeheadInstance
                       Dim oSiteToBridgeheadInstance
                       Set oSiteToBridgeheadInstance = oSitetoBridgeheadCollection.CreateInstance
                       Set oSiteToBridgeheadInstance = oSitetoBridgeheadCollection.CreateInstance
                       oSiteToBridgeheadInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain &amp; &quot;\&quot; &amp; oServer.Get(&quot;CN&quot;)
                       oSiteToBridgeheadInstance.TargetProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain & &quot;\&quot; & oServer.Get(&quot;CN&quot;)
                       oSiteToBridgeheadInstance.AddProperty &quot;TransportType&quot;, Mid(strTransportType, 4, Instr(strTransportType, &quot;,&quot;) - 4)
                       oSiteToBridgeheadInstance.AddProperty &quot;TransportType&quot;, Mid(strTransportType, 4, Instr(strTransportType, &quot;,&quot;) - 4)
                       oSitetoBridgeheadCollection.AddInstance oSiteToBridgeheadInstance
                       oSitetoBridgeheadCollection.AddInstance oSiteToBridgeheadInstance
Line 354: Line 354:
                     Dim oGCInstance
                     Dim oGCInstance
                     Set oGCInstance = oGCCollection.CreateInstance
                     Set oGCInstance = oGCCollection.CreateInstance
                     oGCInstance.SourceProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain &amp; &quot;\&quot; &amp; oServer.Get(&quot;CN&quot;)
                     oGCInstance.SourceProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomain & &quot;\&quot; & oServer.Get(&quot;CN&quot;)
                     oGCInstance.TargetProperty.AddKeyProperty &quot;GC Name&quot;, strFlatDomain &amp; &quot;\&quot; &amp; oServer.Get(&quot;CN&quot;)
                     oGCInstance.TargetProperty.AddKeyProperty &quot;GC Name&quot;, strFlatDomain & &quot;\&quot; & oServer.Get(&quot;CN&quot;)
                      
                      
                     oGCCollection.AddInstance oGCInstance
                     oGCCollection.AddInstance oGCInstance
Line 370: Line 370:
             ' Find all the subnets for the site
             ' Find all the subnets for the site
             Dim rsSubnets
             Dim rsSubnets
             strQuery = &quot;<LDAP://&quot; &amp; oRootDSE.Get(&quot;DnsHostName&quot;) &amp; &quot;/CN=Sites,&quot; &amp; oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) &amp; &quot;>;(&amp;(objectCategory=subnet)(siteObject=&quot; &amp; rsSites.Fields(&quot;distinguishedName&quot;) &amp; &quot;));cn;subtree&quot;
             strQuery = &quot;<LDAP://&quot; & oRootDSE.Get(&quot;DnsHostName&quot;) & &quot;/CN=Sites,&quot; & oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) & &quot;>;(&(objectCategory=subnet)(siteObject=&quot; & rsSites.Fields(&quot;distinguishedName&quot;) & &quot;));cn;subtree&quot;
             Set rsSubnets = oADOConn.Execute(strQuery)
             Set rsSubnets = oADOConn.Execute(strQuery)
             If Err <> 0 Then
             If Err <> 0 Then
               CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
               CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                           EVENT_TYPE_WARNING, _
                           EVENT_TYPE_WARNING, _
                           &quot;The query '&quot; &amp; strQuery &amp; &quot;' failed to execute.&quot; &amp; vbCrLf &amp; _
                           &quot;The query '&quot; & strQuery & &quot;' failed to execute.&quot; & vbCrLf & _
                           &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                           &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                           &quot;The error returned was:&quot; &amp; _
                           &quot;The error returned was:&quot; & _
                           vbCrLf &amp; GetErrorString(Err)
                           vbCrLf & GetErrorString(Err)
               oSiteInstance.AddProperty &quot;Subnets&quot;, &quot;&quot;
               oSiteInstance.AddProperty &quot;Subnets&quot;, &quot;&quot;
             Else
             Else
Line 391: Line 391:
                 iSubnetCount = iSubnetCount + 1
                 iSubnetCount = iSubnetCount + 1
                 If iSubnetCount <= 5 Then
                 If iSubnetCount <= 5 Then
                   strSubnets = strSubnets &amp; vbCrLf &amp; rsSubnets.Fields(&quot;cn&quot;)
                   strSubnets = strSubnets & vbCrLf & rsSubnets.Fields(&quot;cn&quot;)
                 Else
                 Else
                   strSubnets = strSubnets &amp; vbCrLf &amp; &quot;...&quot;
                   strSubnets = strSubnets & vbCrLf & &quot;...&quot;
                 End If
                 End If
                
                
Line 406: Line 406:
             ' Find the ISTG for the site.
             ' Find the ISTG for the site.
             Dim rsSiteSettings
             Dim rsSiteSettings
             strQuery = &quot;<&quot; &amp; rsSites.Fields(&quot;adspath&quot;) &amp; &quot;>;(interSiteTopologyGenerator=*);interSiteTopologyGenerator,options;subtree&quot;
             strQuery = &quot;<&quot; & rsSites.Fields(&quot;adspath&quot;) & &quot;>;(interSiteTopologyGenerator=*);interSiteTopologyGenerator,options;subtree&quot;
             Set rsSiteSettings = oADOConn.Execute(strQuery)
             Set rsSiteSettings = oADOConn.Execute(strQuery)
             If Err <> 0 Then
             If Err <> 0 Then
               CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
               CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                           EVENT_TYPE_WARNING, _
                           EVENT_TYPE_WARNING, _
                           &quot;The query '&quot; &amp; strQuery &amp; &quot;' failed to execute.&quot; &amp; vbCrLf &amp; _
                           &quot;The query '&quot; & strQuery & &quot;' failed to execute.&quot; & vbCrLf & _
                           &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                           &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                           &quot;The error returned was:&quot; &amp; _
                           &quot;The error returned was:&quot; & _
                           vbCrLf &amp; GetErrorString(Err)
                           vbCrLf & GetErrorString(Err)
             Else
             Else
               If Not rsSiteSettings.EOF Then
               If Not rsSiteSettings.EOF Then
Line 424: Line 424:
                  
                  
                   Dim oISTG
                   Dim oISTG
                   Set oISTG = GetObject(&quot;LDAP://&quot; &amp; rsSiteSettings.Fields(&quot;interSiteTopologyGenerator&quot;) )
                   Set oISTG = GetObject(&quot;LDAP://&quot; & rsSiteSettings.Fields(&quot;interSiteTopologyGenerator&quot;) )
                   If Err <> 0 Then
                   If Err <> 0 Then
                     oSiteInstance.AddProperty &quot;ISTG Role Holder&quot;, &quot;Unknown&quot;
                     oSiteInstance.AddProperty &quot;ISTG Role Holder&quot;, &quot;Unknown&quot;
Line 456: Line 456:


         Dim rsSiteLinks
         Dim rsSiteLinks
         strQuery = &quot;<LDAP://&quot; &amp; oRootDSE.Get(&quot;DnsHostName&quot;) &amp; &quot;/CN=Inter-site Transports,CN=Sites,&quot; &amp; oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) &amp; &quot;>;(objectCategory=siteLink);cn,cost,siteList,replInterval,adspath,schedule,isDeleted;subtree&quot;
         strQuery = &quot;<LDAP://&quot; & oRootDSE.Get(&quot;DnsHostName&quot;) & &quot;/CN=Inter-site Transports,CN=Sites,&quot; & oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) & &quot;>;(objectCategory=siteLink);cn,cost,siteList,replInterval,adspath,schedule,isDeleted;subtree&quot;
         Set rsSiteLinks = oADOConn.Execute(strQuery)
         Set rsSiteLinks = oADOConn.Execute(strQuery)
         if Err.number <> 0 Then
         if Err.number <> 0 Then
           oError.Init(Err)
           oError.Init(Err)
           On Error Goto 0
           On Error Goto 0
           oError.Raise &quot;The query '&quot; &amp; strQuery &amp; &quot;' failed to execute.&quot;
           oError.Raise &quot;The query '&quot; & strQuery & &quot;' failed to execute.&quot;
         Else
         Else
           While NOT rsSiteLinks.EOF
           While NOT rsSiteLinks.EOF
Line 472: Line 472:
               Dim strSiteLinkPath
               Dim strSiteLinkPath
               strSiteLinkPath = rsSiteLinks.Fields(&quot;adspath&quot;)
               strSiteLinkPath = rsSiteLinks.Fields(&quot;adspath&quot;)
               oError.Raise &quot;Failed to determine if object '&quot; &amp; strSiteLinkPath &amp; &quot;' is deleted.&quot;
               oError.Raise &quot;Failed to determine if object '&quot; & strSiteLinkPath & &quot;' is deleted.&quot;
             Else
             Else
               If IsNull(bDeleted) Or bDeleted = False Then
               If IsNull(bDeleted) Or bDeleted = False Then
Line 479: Line 479:
                   oError.Init(Err)
                   oError.Init(Err)
                   On Error Goto 0
                   On Error Goto 0
                   oError.Raise &quot;Failed to get object '&quot; &amp; rsSiteLinks.Fields(&quot;adspath&quot;) &amp; &quot;'.&quot;
                   oError.Raise &quot;Failed to get object '&quot; & rsSiteLinks.Fields(&quot;adspath&quot;) & &quot;'.&quot;
                   strTransport = &quot;Unknown&quot;
                   strTransport = &quot;Unknown&quot;
                   Err.Clear
                   Err.Clear
Line 532: Line 532:
          
          
         Dim rsNamingContexts
         Dim rsNamingContexts
         strQuery = &quot;<LDAP://&quot; &amp; oRootDSE.Get(&quot;DnsHostName&quot;) &amp; &quot;/&quot; &amp; oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) &amp; &quot;>;(&amp;(objectCategory=crossRef)(!(|(cn=Enterprise Schema)(cn=Enterprise Configuration))));ncName,dnsRoot;subtree&quot;
         strQuery = &quot;<LDAP://&quot; & oRootDSE.Get(&quot;DnsHostName&quot;) & &quot;/&quot; & oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) & &quot;>;(&(objectCategory=crossRef)(!(|(cn=Enterprise Schema)(cn=Enterprise Configuration))));ncName,dnsRoot;subtree&quot;
         Set rsNamingContexts = oADOConn.Execute(strQuery)
         Set rsNamingContexts = oADOConn.Execute(strQuery)
         If Err.number <> 0 Then
         If Err.number <> 0 Then
           oError.Init(Err)
           oError.Init(Err)
           On Error Goto 0
           On Error Goto 0
           oError.Raise &quot;The query '&quot; &amp; strQuery &amp; &quot;' failed to execute.&quot;
           oError.Raise &quot;The query '&quot; & strQuery & &quot;' failed to execute.&quot;
         Else
         Else
           ' Create a collection to hold all the naming contexts
           ' Create a collection to hold all the naming contexts
Line 590: Line 590:
                   CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                   CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                               EVENT_TYPE_WARNING, _
                               EVENT_TYPE_WARNING, _
                               &quot;Failed to get the RID Master for the domain '&quot; &amp; _
                               &quot;Failed to get the RID Master for the domain '&quot; & _
                               arrDNSRoots(0) &amp; &quot;'.&quot; &amp; vbCrLf &amp; _
                               arrDNSRoots(0) & &quot;'.&quot; & vbCrLf & _
                               &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                               &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                               &quot;The error returned was:&quot; &amp; _
                               &quot;The error returned was:&quot; & _
                               vbCrLf &amp; GetErrorString(Err)             
                               vbCrLf & GetErrorString(Err)             
                 Else
                 Else
                   AddSourceInstanceToCollection oMasterCollection, strMaster
                   AddSourceInstanceToCollection oMasterCollection, strMaster
Line 609: Line 609:
                   CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                   CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                               EVENT_TYPE_WARNING, _
                               EVENT_TYPE_WARNING, _
                               &quot;Failed to get the PDC Master for the domain '&quot; &amp; _
                               &quot;Failed to get the PDC Master for the domain '&quot; & _
                               arrDNSRoots(0) &amp; &quot;'.&quot; &amp; vbCrLf &amp; _
                               arrDNSRoots(0) & &quot;'.&quot; & vbCrLf & _
                               &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                               &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                               &quot;The error returned was:&quot; &amp; _
                               &quot;The error returned was:&quot; & _
                               vbCrLf &amp; GetErrorString(Err)             
                               vbCrLf & GetErrorString(Err)             
                 Else
                 Else
                   AddSourceInstanceToCollection oMasterCollection, strMaster
                   AddSourceInstanceToCollection oMasterCollection, strMaster
Line 629: Line 629:
                 CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                 CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                             EVENT_TYPE_WARNING, _
                             EVENT_TYPE_WARNING, _
                             &quot;Failed to get the Infrastructure Master for the domain '&quot; &amp; _
                             &quot;Failed to get the Infrastructure Master for the domain '&quot; & _
                             arrDNSRoots(0) &amp; &quot;'.&quot; &amp; vbCrLf &amp; _
                             arrDNSRoots(0) & &quot;'.&quot; & vbCrLf & _
                             &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                             &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                             &quot;The error returned was:&quot; &amp; _
                             &quot;The error returned was:&quot; & _
                             vbCrLf &amp; GetErrorString(Err)             
                             vbCrLf & GetErrorString(Err)             
               Else
               Else
                 AddSourceInstanceToCollection oMasterCollection, strMaster
                 AddSourceInstanceToCollection oMasterCollection, strMaster
Line 655: Line 655:
         CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
         CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                     EVENT_TYPE_WARNING, _
                     EVENT_TYPE_WARNING, _
                     &quot;Failed to get the Domain Naming Master.&quot; &amp; vbCrLf &amp; _
                     &quot;Failed to get the Domain Naming Master.&quot; & vbCrLf & _
                     &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                     &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                     &quot;The error returned was:&quot; &amp; _
                     &quot;The error returned was:&quot; & _
                     vbCrLf &amp; GetErrorString(Err)             
                     vbCrLf & GetErrorString(Err)             
       Else
       Else
         AddComputerRelationshipToCollection oMasterCollection, strMaster, &quot;DomainNamingMasterName&quot;
         AddComputerRelationshipToCollection oMasterCollection, strMaster, &quot;DomainNamingMasterName&quot;
Line 670: Line 670:
         CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
         CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                     EVENT_TYPE_WARNING, _
                     EVENT_TYPE_WARNING, _
                     &quot;Failed to get the Schema Master.&quot; &amp; vbCrLf &amp; _
                     &quot;Failed to get the Schema Master.&quot; & vbCrLf & _
                     &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                     &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                     &quot;The error returned was:&quot; &amp; _
                     &quot;The error returned was:&quot; & _
                     vbCrLf &amp; GetErrorString(Err)             
                     vbCrLf & GetErrorString(Err)             
       Else
       Else
         AddComputerRelationshipToCollection oMasterCollection, strMaster, &quot;SchemaMasterName&quot;
         AddComputerRelationshipToCollection oMasterCollection, strMaster, &quot;SchemaMasterName&quot;
Line 687: Line 687:
     End If
     End If


     ScriptContext.Echo &quot;AD Discovery took &quot; &amp; DateDiff(&quot;s&quot;, dtStart, Now) &amp; &quot; seconds to complete&quot;
     ScriptContext.Echo &quot;AD Discovery took &quot; & DateDiff(&quot;s&quot;, dtStart, Now) & &quot; seconds to complete&quot;
End Sub
End Sub


Line 711: Line 711:
     CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
     CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                 EVENT_TYPE_WARNING, _
                 EVENT_TYPE_WARNING, _
                 &quot;Failed to get the flat names for the computer '&quot; &amp; strSource &amp; &quot;'.&quot; &amp; vbCrLf &amp; _
                 &quot;Failed to get the flat names for the computer '&quot; & strSource & &quot;'.&quot; & vbCrLf & _
                 &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                 &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                 &quot;The error returned was:&quot; &amp; _
                 &quot;The error returned was:&quot; & _
                 vbCrLf &amp; GetErrorString(Err)             
                 vbCrLf & GetErrorString(Err)             
   Else
   Else
     Dim oInstance
     Dim oInstance
     Set oInstance = oCollection.CreateInstance
     Set oInstance = oCollection.CreateInstance
     oInstance.SourceProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomainName &amp; &quot;\&quot; &amp; strFlatComputerName
     oInstance.SourceProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomainName & &quot;\&quot; & strFlatComputerName
      
      
     oCollection.AddInstance oInstance               
     oCollection.AddInstance oInstance               
Line 747: Line 747:
     CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
     CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                 EVENT_TYPE_WARNING, _
                 EVENT_TYPE_WARNING, _
                 &quot;Failed to get the flat names for the computer '&quot; &amp; strInstance &amp; &quot;'.&quot; &amp; vbCrLf &amp; _
                 &quot;Failed to get the flat names for the computer '&quot; & strInstance & &quot;'.&quot; & vbCrLf & _
                 &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                 &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                 &quot;The error returned was:&quot; &amp; _
                 &quot;The error returned was:&quot; & _
                 vbCrLf &amp; GetErrorString(Err)             
                 vbCrLf & GetErrorString(Err)             
   Else
   Else
     Dim oRelationship
     Dim oRelationship
     Set oRelationship = oCollection.CreateInstance
     Set oRelationship = oCollection.CreateInstance
     oRelationship.SourceProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomainName &amp; &quot;\&quot; &amp; strFlatComputerName
     oRelationship.SourceProperty.AddKeyProperty &quot;ComputerName&quot;, strFlatDomainName & &quot;\&quot; & strFlatComputerName
     oRelationship.TargetProperty.AddKeyProperty strTargetKeyName, strFlatDomainName &amp; &quot;\&quot; &amp; strFlatComputerName
     oRelationship.TargetProperty.AddKeyProperty strTargetKeyName, strFlatDomainName & &quot;\&quot; & strFlatComputerName
      
      
     oCollection.AddInstance oRelationship
     oCollection.AddInstance oRelationship
Line 781: Line 781:
   strGUID = ReformatGUID(oNTDSASettings.GUID)
   strGUID = ReformatGUID(oNTDSASettings.GUID)


   strQuery = &quot;<LDAP://&quot; &amp; oRootDSE.Get(&quot;DnsHostName&quot;) &amp; &quot;/<GUID=&quot; &amp; strGUID &amp; &quot;>>;(&amp;(objectCategory=nTDSDSA)(options:1.2.840.113556.1.4.803:=1));adspath,cn;base&quot;
   strQuery = &quot;<LDAP://&quot; & oRootDSE.Get(&quot;DnsHostName&quot;) & &quot;/<GUID=&quot; & strGUID & &quot;>>;(&(objectCategory=nTDSDSA)(options:1.2.840.113556.1.4.803:=1));adspath,cn;base&quot;
   Set rsGCs = oADOConn.Execute(strQuery)
   Set rsGCs = oADOConn.Execute(strQuery)
   If Err <> 0 Then
   If Err <> 0 Then
     CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
     CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
                 EVENT_TYPE_WARNING, _
                 EVENT_TYPE_WARNING, _
                 &quot;The query '&quot; &amp; strQuery &amp; &quot;' failed to execute.&quot; &amp; vbCrLf &amp; _
                 &quot;The query '&quot; & strQuery & &quot;' failed to execute.&quot; & vbCrLf & _
                 &quot;This will cause an incomplete topology to be displayed.&quot; &amp; vbCrLf &amp; _
                 &quot;This will cause an incomplete topology to be displayed.&quot; & vbCrLf & _
                 &quot;The error returned was:&quot; &amp; _
                 &quot;The error returned was:&quot; & _
                 vbCrLf &amp; GetErrorString(Err)
                 vbCrLf & GetErrorString(Err)
   Else
   Else
     If Not rsGCs.EOF Then
     If Not rsGCs.EOF Then
Line 808: Line 808:
'
'
   If Len(strOrigGUID) <> 32 Then
   If Len(strOrigGUID) <> 32 Then
     Err.Raise &amp;H80070057, SCRIPT_NAME &amp; &quot;::ReformatGUID&quot;, &quot;Invalid Argument&quot;  
     Err.Raise &H80070057, SCRIPT_NAME & &quot;::ReformatGUID&quot;, &quot;Invalid Argument&quot;  
   End If
   End If
    
    
   ReformatGUID = Mid(strOrigGUID, 7, 2) &amp; Mid(strOrigGUID, 5, 2) &amp; Mid(strOrigGUID, 3, 2) &amp; Mid(strOrigGUID, 1, 2)
   ReformatGUID = Mid(strOrigGUID, 7, 2) & Mid(strOrigGUID, 5, 2) & Mid(strOrigGUID, 3, 2) & Mid(strOrigGUID, 1, 2)
   ReformatGUID = ReformatGUID &amp; &quot;-&quot;
   ReformatGUID = ReformatGUID & &quot;-&quot;
   ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 11, 2) &amp; Mid(strOrigGUID, 9, 2)
   ReformatGUID = ReformatGUID & Mid(strOrigGUID, 11, 2) & Mid(strOrigGUID, 9, 2)
   ReformatGUID = ReformatGUID &amp; &quot;-&quot;
   ReformatGUID = ReformatGUID & &quot;-&quot;
   ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 15, 2) &amp; Mid(strOrigGUID, 13, 2)
   ReformatGUID = ReformatGUID & Mid(strOrigGUID, 15, 2) & Mid(strOrigGUID, 13, 2)
   ReformatGUID = ReformatGUID &amp; &quot;-&quot;
   ReformatGUID = ReformatGUID & &quot;-&quot;
   ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 17, 4)  
   ReformatGUID = ReformatGUID & Mid(strOrigGUID, 17, 4)  
   ReformatGUID = ReformatGUID &amp; &quot;-&quot;
   ReformatGUID = ReformatGUID & &quot;-&quot;
   ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 21, 12)
   ReformatGUID = ReformatGUID & Mid(strOrigGUID, 21, 12)
End Function
End Function


Line 869: Line 869:
     ' If we don't have an error description, then check to see if the error
     ' 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.
     ' is a 0x8007xxxx error.  If it is, then look it up.
     Const ErrorMask = &amp;HFFFF0000   
     Const ErrorMask = &HFFFF0000   
     Const HiWord8007 = &amp;H80070000
     Const HiWord8007 = &H80070000
     Const LoWordMask = 65535          ' This is equivalent to 0x0000FFFF
     Const LoWordMask = 65535          ' This is equivalent to 0x0000FFFF


Line 879: Line 879:
       If Err = 0 Then
       If Err = 0 Then
         Dim oExec  
         Dim oExec  
         Set oExec = oShell.Exec(&quot;net helpmsg &quot; &amp; (lErr And LoWordMask))
         Set oExec = oShell.Exec(&quot;net helpmsg &quot; & (lErr And LoWordMask))


         Dim strMessage, i
         Dim strMessage, i
Line 892: Line 892:
   End If
   End If


   GetErrorString = vbCrLf &amp; &quot;The error returned was: '&quot; &amp; strErr &amp; &quot;' (0x&quot; &amp; Hex(lErr) &amp; &quot;)&quot;
   GetErrorString = vbCrLf & &quot;The error returned was: '&quot; & strErr & &quot;' (0x&quot; & Hex(lErr) & &quot;)&quot;
End Function
End Function


Line 933: Line 933:
   On Error Resume Next
   On Error Resume Next
   Dim oContainer, oNTDS, oMaster, lErr, strErr, strSource, strLDAPSearchComputer
   Dim oContainer, oNTDS, oMaster, lErr, strErr, strSource, strLDAPSearchComputer
   strLDAPSearchComputer = &quot;LDAP://&quot; &amp; strDNSHost &amp; &quot;/&quot;
   strLDAPSearchComputer = &quot;LDAP://&quot; & strDNSHost & &quot;/&quot;
   Set oContainer = GetObject(strLDAPSearchComputer &amp; &quot;<WKGUID=2fbac1870ade11d297c400c04fd8d5cd,&quot; &amp; strNCDN &amp; &quot;>&quot;)
   Set oContainer = GetObject(strLDAPSearchComputer & &quot;<WKGUID=2fbac1870ade11d297c400c04fd8d5cd,&quot; & strNCDN & &quot;>&quot;)
   If Err <> 0 Then
   If Err <> 0 Then
     lErr = Err.number
     lErr = Err.number
     strErr = &quot;Failed to bind to '&quot; &amp; strLDAPSearchComputer &amp; _
     strErr = &quot;Failed to bind to '&quot; & strLDAPSearchComputer & _
               &quot;<WKGUID=2fbac1870ade11d297c400c04fd8d5cd,&quot; &amp; _
               &quot;<WKGUID=2fbac1870ade11d297c400c04fd8d5cd,&quot; & _
               strNCDN &amp; &quot;>'.&quot; &amp; GetErrorString(Err)
               strNCDN & &quot;>'.&quot; & GetErrorString(Err)
     On Error Goto 0
     On Error Goto 0
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
   End If
   End If
   Set oNTDS = GetObject(strLDAPSearchComputer &amp; oContainer.Get(&quot;fSMORoleOwner&quot;))
   Set oNTDS = GetObject(strLDAPSearchComputer & oContainer.Get(&quot;fSMORoleOwner&quot;))
   If Err <> 0 Then
   If Err <> 0 Then
     lErr = Err.number
     lErr = Err.number
     strErr = &quot;Failed to get the 'fSMORoleOwner' attribute from the object '&quot; &amp; _
     strErr = &quot;Failed to get the 'fSMORoleOwner' attribute from the object '&quot; & _
               strLDAPSearchComputer &amp; &quot;<WKGUID=2fbac1870ade11d297c400c04fd8d5cd,&quot; &amp; _
               strLDAPSearchComputer & &quot;<WKGUID=2fbac1870ade11d297c400c04fd8d5cd,&quot; & _
               strNCDN &amp; &quot;>'.&quot; &amp; GetErrorString(Err)
               strNCDN & &quot;>'.&quot; & GetErrorString(Err)
     On Error Goto 0
     On Error Goto 0
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
Line 955: Line 955:
   If Err <> 0 Then
   If Err <> 0 Then
     lErr = Err.number
     lErr = Err.number
     strErr = &quot;Failed to get the object '&quot; &amp; oNTDS.Parent &amp; &quot;'.&quot; &amp; GetErrorString(Err)
     strErr = &quot;Failed to get the object '&quot; & oNTDS.Parent & &quot;'.&quot; & GetErrorString(Err)
     On Error Goto 0
     On Error Goto 0
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
Line 962: Line 962:
   If Err <> 0 Then
   If Err <> 0 Then
     lErr = Err.number
     lErr = Err.number
     strErr = &quot;Failed to get the dnsHostName attribute of '&quot; &amp; oNTDS.Parent &amp; &quot;'.&quot; &amp; GetErrorString(Err)
     strErr = &quot;Failed to get the dnsHostName attribute of '&quot; & oNTDS.Parent & &quot;'.&quot; & GetErrorString(Err)
     On Error Goto 0
     On Error Goto 0
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
     Err.Raise lErr, &quot;GetInfrastructureMasterUsingWellKnownGUID&quot;, strErr
Line 984: Line 984:
   ' the top level DNS name.
   ' the top level DNS name.
   Dim strQuery
   Dim strQuery
   strQuery = &quot;<LDAP://&quot; &amp; oRootDSE.Get(&quot;DnsHostName&quot;) &amp; &quot;/&quot; &amp; oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) &amp; &quot;>;(&amp;(objectCategory=Server)(dnsHostName=&quot; &amp; strDNSHostName &amp; &quot;));serverReference,distinguishedName;subtree&quot;
   strQuery = &quot;<LDAP://&quot; & oRootDSE.Get(&quot;DnsHostName&quot;) & &quot;/&quot; & oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) & &quot;>;(&(objectCategory=Server)(dnsHostName=&quot; & strDNSHostName & &quot;));serverReference,distinguishedName;subtree&quot;
   If Err <> 0 Then
   If Err <> 0 Then
     oError.Init(Err)
     oError.Init(Err)
     On Error Goto 0
     On Error Goto 0
     oError.Raise &quot;Failed to construct the query to find the Server '&quot; &amp; strDNSHostName &amp; &quot;'.&quot;
     oError.Raise &quot;Failed to construct the query to find the Server '&quot; & strDNSHostName & &quot;'.&quot;
   End If
   End If


Line 996: Line 996:
     oError.Init(Err)
     oError.Init(Err)
     On Error Goto 0
     On Error Goto 0
     oError.Raise &quot;Failed to execute the query to find the Server '&quot; &amp; strDNSHostName &amp; &quot;'.&quot;
     oError.Raise &quot;Failed to execute the query to find the Server '&quot; & strDNSHostName & &quot;'.&quot;
   End If
   End If
    
    
Line 1,005: Line 1,005:
       oError.Init(Err)
       oError.Init(Err)
       On Error Goto 0
       On Error Goto 0
       oError.Raise &quot;Failed to get the ServerReference attribute of '&quot; &amp; strDNSHostName &amp; &quot;'.&quot;
       oError.Raise &quot;Failed to get the ServerReference attribute of '&quot; & strDNSHostName & &quot;'.&quot;
     End If
     End If
      
      
Line 1,012: Line 1,012:
       strDomainDN = Mid(strServerRef, iStartDomain)
       strDomainDN = Mid(strServerRef, iStartDomain)
        
        
       strQuery = &quot;<LDAP://&quot; &amp; oRootDSE.Get(&quot;DnsHostName&quot;) &amp; &quot;/&quot; &amp; oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) &amp; &quot;>;(&amp;(objectCategory=crossRef)(ncName=&quot; &amp; strDomainDN &amp; &quot;));netbiosName,dnsRoot;subtree&quot;
       strQuery = &quot;<LDAP://&quot; & oRootDSE.Get(&quot;DnsHostName&quot;) & &quot;/&quot; & oRootDSE.Get(&quot;ConfigurationNamingContext&quot;) & &quot;>;(&(objectCategory=crossRef)(ncName=&quot; & strDomainDN & &quot;));netbiosName,dnsRoot;subtree&quot;
       If Err <> 0 Then
       If Err <> 0 Then
         oError.Init(Err)
         oError.Init(Err)
         On Error Goto 0
         On Error Goto 0
         oError.Raise &quot;Failed to construct the query to find the Domain '&quot; &amp; strDomainDN &amp; &quot;'.&quot;
         oError.Raise &quot;Failed to construct the query to find the Domain '&quot; & strDomainDN & &quot;'.&quot;
       End If
       End If


Line 1,024: Line 1,024:
         oError.Init(Err)
         oError.Init(Err)
         On Error Goto 0
         On Error Goto 0
         oError.Raise &quot;Failed to execute the query to find the Domain '&quot; &amp; strDomainDN &amp; &quot;'.&quot;
         oError.Raise &quot;Failed to execute the query to find the Domain '&quot; & strDomainDN & &quot;'.&quot;
       End If
       End If
        
        
Line 1,057: Line 1,057:
   If Len(GetFlatDomainForDC) = 0 Then
   If Len(GetFlatDomainForDC) = 0 Then
     On Error Goto 0
     On Error Goto 0
     Err.Raise E_INVALIDARG, SCRIPT_NAME &amp; &quot;::GetFlatDomainForDC&quot;, &quot;Failed to obtain the flat domain name for  '&quot; &amp; strDNSHostName &amp; &quot;'.&quot;
     Err.Raise E_INVALIDARG, SCRIPT_NAME & &quot;::GetFlatDomainForDC&quot;, &quot;Failed to obtain the flat domain name for  '&quot; & strDNSHostName & &quot;'.&quot;
   End If
   End If
End Function</pre>
End Function</pre>

Latest revision as of 14:17, 21 July 2020

Knowledge Base


Errors occur after you install the Microsoft Operations Manager 2005 Active Directory Management Pack in a Windows 2000 forest

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:

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 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:

  1. Start the MOM 2005 Administrator console.
  2. 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.
  3. Open the Script - AD Topology Discovery script.
  4. Click the Responses tab.
  5. In the Response list, click Script - AD Topology Discovery, and then click Edit.
  6. In the Launch a Script dialog box, click Edit.
  7. Click the Script tab.
  8. 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.
  9. Paste the contents of the ADTopologyScriptNew.txt file into the Specify the JScript source code for the script box.
  10. 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