AD Remote Topology Discovery

Microsoft.AD.Remote.Topology.Discovery (Discovery)

Performs the AD Connection Object Discovery. Runs on all managed DCs

Knowledge Base article:

Summary

This discovery rule discovers the remote connection object on each Domain Controller. The remote connection objects are visible in the AD Topology View.

Configuration

This discovery requires the “Agent Proxy” to be enabled on all DCs. See configuration guide for details.

This rule can be disabled if the AD topology view, and the associated availability of are not used.

Element properties:

TargetMicrosoft.Windows.Server.2012.R2.AD.DomainControllerRole
EnabledTrue
Frequency86400
RemotableFalse

Object Discovery Details:

Discovered Classes and their attribuets:

Member Modules:

ID Module Type TypeId RunAs 
DiscoveryDataSource DataSource Microsoft.Windows.Server.AD.CommandExecuterDiscoveryDataSource Default

Source Code:

<Discovery ID="Microsoft.AD.Remote.Topology.Discovery" Enabled="true" Target="Microsoft.Windows.Server.2012.R2.AD.DomainControllerRole" ConfirmDelivery="false" Remotable="false" Priority="Normal">
<Category>Discovery</Category>
<DiscoveryTypes>
<DiscoveryClass TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject">
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="Name"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="LastSuccessfulSyncTime"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="ConnectionState"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="ConnectionStyle"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="ConsecutiveFailures"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="TransportType"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="OtherPartitionsHeld"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="DomainPartitionsHeld"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="ApplicationPartitionsHeld"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.Library.ConnectionObject" PropertyID="ManualConnection"/>
</DiscoveryClass>
</DiscoveryTypes>
<DataSource ID="DiscoveryDataSource" TypeID="AD!Microsoft.Windows.Server.AD.CommandExecuterDiscoveryDataSource">
<IntervalSeconds>86400</IntervalSeconds>
<ApplicationName>%windir%\System32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>$file/ADRemoteTopologyDiscovery.vbs$ 0 $MPElement$ $Target/Id$ $Target/Host/Property[Type="Windows!Microsoft.Windows.Computer"]/PrincipalName$ $Target/Host/Property[Type="Windows!Microsoft.Windows.Computer"]/NetbiosComputerName$</CommandLine>
<TimeoutSeconds>300</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>ADRemoteTopologyDiscovery.vbs</Name>
<Contents><Script>'*************************************************************************
' Script Name - AD Remote Topology Discovery
'
' Purpose - Collects information and applies it to the topology
' stored in MOM
'
' Parameters - LogSuccessEvent - True/False value to indicates to log an
' an event for script success
' (useful for demos and debugging)
'
' (c) Copyright 2000, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************

Option Explicit

SetLocale("en-us")

'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 = 66
Const EVENT_ID_SCRIPT_ERROR = 1000
Const EVENT_ID_SUCCESS = 99
Const EVENT_ID_NOT_AN_EVENT = 2
Const EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE = 4000
Const EVENT_ID_REPLPROVINSTALLED = 68
Const EVENT_ID_AGENTLESS = 98

' Other Constants
Const SCRIPT_NAME = "AD Remote Topology Discovery"
Const E_INVALIDARG = &amp;H80070057

Const CONNECTION_ERROR = 3
Const CONNECTION_WARNING = 2
Const CONNECTION_OKAY = 1
Const CONNECTION_NOSTATUS = 0

Const OPTIONS_MANUAL = 0
Const OPTIONS_AUTO = 1
Const OPTIONS_INVALID = -1

' Other Variables
Dim oArgs,SourceType, SourceID, ManagedEntityId, TargetFQDNComputer, TargetNetbiosComputer,IsTargetAgentless, Discoveryflag
Set oArgs = WScript.Arguments
if oArgs.Count &lt; 5 Then
Wscript.Quit -1
End If

SourceType = oArgs(0)
SourceID = oArgs(1)
ManagedEntityId = oArgs(2)
TargetFQDNComputer = oArgs(3)
TargetNetbiosComputer = oArgs(4)
IsTargetAgentless = false
Discoveryflag = false

Class ConnObjProperties
Dim strLastSuccessfulSyncTime
Dim strComputerName
Dim strDnsHostName
Dim iConnectionState
Dim iConsecutiveFailures
Dim iOptions
Dim strNC
Dim strDomainNC
Dim strNDNC
Dim strTransportType
Dim bInterSite

Sub Init()
strLastSuccessfulSyncTime = "Never"
strComputerName = ""
strDnsHostName = ""
iConnectionState = CONNECTION_NOSTATUS
iConsecutiveFailures = 0
iOptions = OPTIONS_INVALID
strNC = ""
strDomainNC = ""
strNDNC = ""
strTransportType = "Unknown"
End Sub
End Class

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.Raise Number, Source, strDescription &amp; GetErrorString(Number, Description)
End Sub
End Class

Dim oError, oADOConn, strLocalDC, oRootDSE
Set oError = new Error
On Error Resume Next

'MOMV3 script API parameters
Dim oAPI,oDiscData
Set oAPI = CreateObject("Mom.ScriptAPI")
If Err &lt;&gt; 0 Then
Wscript.Quit -1
End If

Set oDiscData = oAPI.CreateDiscoveryData (SourceType, SourceID, ManagedEntityId)
If Err &lt;&gt; 0 Then
Wscript.Quit -1
End If

If Not(IsTargetAgentless) Then
DoADDiscovery

If Err &lt;&gt; 0 Then
CreateEvent EVENT_ID_SCRIPT_ERROR, _
EVENT_TYPE_WARNING, _
"An error occurred while executing '" &amp; SCRIPT_NAME &amp; "'" &amp; _
vbCrLf &amp; Err.Description &amp; vbCrLf &amp; "0x" &amp; Hex(Err.number)
End If

If Discoveryflag = false Then
Call oAPI.Return(oDiscData)
End If
Else
CreateEvent EVENT_ID_AGENTLESS, EVENT_TYPE_ERROR, "The AD Management Pack does not support the agentless management mode." &amp; vbCrLf &amp; _
"The script '" &amp; SCRIPT_NAME &amp; "' will not execute." &amp; vbCrLf &amp; _
"To prevent this alert being generated again, either change the monitoring " &amp; _
"mode of the computer '" &amp; TargetFQDNComputer &amp; "' to agent-managed " &amp; _
"or disable the rule that generated this alert."
If Discoveryflag = false Then
Call oAPI.Return(oDiscData)
End If
End If

Sub DoADDiscovery()
Dim dtStart
dtStart = Now

Dim dictConnObj
Set dictConnObj = CreateObject("Scripting.Dictionary")

Dim strLocalSite
strLocalDC = TargetFQDNComputer

' First do a query and load all the appropriate connection objects from the directory,
' and set their status to NOSTATUS. Then we'll query WMI and get the status info for
' each connection object.
On Error Resume Next

Set oADOConn = CreateObject("ADODB.Connection")
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to CreateObject 'ADODB.Connection'."
End If

oADOConn.Provider = "ADSDsOObject"
oADOConn.Open "ADs Provider"
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to initialize the 'ADSDSOObject'."
End If

Set oRootDSE = GetObject("LDAP://" &amp; strLocalDC &amp; "/RootDSE")
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get 'LDAP://RootDSE'."
End If

Dim strQuery
strQuery = "&lt;LDAP://" &amp; strLocalDC &amp; "/" &amp; oRootDSE.Get("ConfigurationNamingContext") &amp; "&gt;;(&amp;(objectCategory=Server)(cn=" &amp; TargetNetbiosComputer &amp; "));adspath,distinguishedName;subtree"
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to construct the query to find the local Server."
End If

Dim rsServers
Set rsServers = oADOConn.Execute(strQuery)
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query '" &amp; strQuery &amp; "'."
End If

Do Until rsServers.EOF
Set oNTDSSettings = GetObject("LDAP://" &amp; strLocalDC &amp; "/CN=NTDS Settings," &amp; rsServers.Fields("distinguishedName"))
If Err = 0 Then
Exit Do
End If
Err.Clear

rsServers.MoveNext
Loop
If Err &lt;&gt; 0 Or rsServers.EOF Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to find the server object for '" &amp; strLocalDC &amp; "'."
End If

Err.Clear
strLocalSite = GetSiteFromDN(rsServers.Fields("distinguishedName"))
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get the site name for '" &amp; strLocalDC &amp; "'."
End If

strQuery = "&lt;" &amp; rsServers.Fields("adspath") &amp; "&gt;;(objectCategory=ntdsconnection);fromServer,cn,adspath,mS-DS-ReplicatesNCReason,options,transportType;subtree"
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to construct the query to find the connection objects for '" &amp; strLocalDC &amp; "'."
End If

Dim rsConnObjs
Set rsConnObjs = oADOConn.Execute(strQuery)
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query '" &amp; strQuery &amp; "'."
End If

While Not rsConnObjs.EOF
On Error Resume Next
' Bind to the fromServer (which is an NTDSSettings object) go to it's parent which is the
' actual server
Dim oNTDSSettings, oParent
Err.Clear
Set oNTDSSettings = GetObject("LDAP://" &amp; rsConnObjs.Fields("fromServer"))
if Err.number &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get '" &amp; "LDAP://" &amp; rsConnObjs.Fields("fromServer") &amp; "'."
End If

Set oParent = GetObject(oNTDSSettings.Parent)
if Err.number &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to bind to '" &amp; oNTDSSettings.Parent &amp; "'."
End If

On Error Goto 0

If Not dictConnObj.Exists(oParent.Get("cn")) Then
Set connObj = new ConnObjProperties
connObj.Init
Else
Set connObj = dictConnObj.Item(oParent.Get("cn"))
End If
connObj.iOptions = rsConnObjs.Fields("options")
If connObj.strComputerName = "" Then
connObj.strComputerName = oParent.Get("cn")
dictConnObj.Add connObj.strComputerName, connObj
End If
connObj.strDnsHostName = oParent.Get("dnsHostName")
Dim arrNCReasons, oNCReason
arrNCReasons = rsConnObjs.Fields("mS-DS-ReplicatesNCReason")
If IsArray(arrNCReasons) Then
For Each oNCReason In arrNCReasons
' Determine whether the NC is an NDNC, a Domain NC or an 'other'
Dim bIsNDNC, bIsDomainNC
bIsNDNC = False
bIsDomainNC = False
strQuery = "&lt;LDAP://" &amp; strLocalDC &amp; "/" &amp; oRootDSE.Get("ConfigurationNamingContext") &amp; "&gt;;(&amp;(objectCategory=crossRef)(nCName=" &amp; oNCReason.DNString &amp; ")(msDS-NC-Replica-Locations=*));adspath;subtree"
Dim rsNDNC
Set rsNDNC = oADOConn.Execute(strQuery)
If Err.number = 0 Then
If rsNDNC.EOF = False Then
bIsNDNC = True
End If
End If
If Left(oNCReason.DNString, 3) = "DC=" Then
bIsDomainNC = True
End If
If bIsNDNC Then
connObj.strNDNC = connObj.strNDNC &amp; vbCrLf &amp; oNCReason.DNString
ElseIf bIsDomainNC Then
connObj.strDomainNC = connObj.strDomainNC &amp; vbCrLf &amp; oNCReason.DNString
Else
connObj.strNC = connObj.strNC &amp; vbCrLf &amp; oNCReason.DNString
End IF
Next
End If

If Len(rsConnObjs.Fields("TransportType")) &gt; 0 Then
If Left(rsConnObjs.Fields("TransportType"), 7) = "CN=SMTP" Then
connObj.strTransportType = "SMTP"
Else
connObj.strTransportType = "IP"
End If
Else
connObj.strTransportType = "IP"
End If

rsConnObjs.MoveNext
Wend

On Error Resume Next
' Connect to ReplProv to determine the state information for each connection object
Dim oWMI, oReplNeighbor, strMessage, bAllLinksFailed
Set oWMI = GetObject("winmgmts:\\" &amp; strLocalDC &amp; "\root\MicrosoftActiveDirectory").InstancesOf("MSAD_ReplNeighbor")
If 0 = Err.number Then
' Test the object returned from the provider to make sure that it actually got it.
' If the provider is incorrectly configured, we may get success from the previous
' call, but the provider may still not be available.
Dim nCount
nCount = oWMI.Count
End If

If 0 = Err.number Then
On Error Goto 0
For Each oReplNeighbor in oWMI
Dim connObj
If Not dictConnObj.Exists(oReplNeighbor.SourceDsaCN) Then
Set connObj = new ConnObjProperties
connObj.Init
Else
Set connObj = dictConnObj.Item(oReplNeighbor.SourceDsaCN)
End If

If connObj.strComputerName = "" Then
connObj.strComputerName = oReplNeighbor.SourceDsaCN
dictConnObj.Add connObj.strComputerName, connObj
End If

If oReplNeighbor.ModifiedNumConsecutiveSyncFailures &gt; 2 Then
If connObj.iConnectionState &lt; CONNECTION_ERROR Then
connObj.iConnectionState = CONNECTION_ERROR
End If
ElseIf oReplNeighbor.ModifiedNumConsecutiveSyncFailures &gt; 0 Then
If connObj.iConnectionState &lt; CONNECTION_WARNING Then
connObj.iConnectionState = CONNECTION_WARNING
End If
Else
If connObj.iConnectionState &lt; CONNECTION_OKAY Then
connObj.iConnectionState = CONNECTION_OKAY
End If
End If

If connObj.iConsecutiveFailures &lt; oReplNeighbor.ModifiedNumConsecutiveSyncFailures Then
connObj.iConsecutiveFailures = oReplNeighbor.ModifiedNumConsecutiveSyncFailures
End If

If oReplNeighbor.SourceDsaSite = strLocalSite Then
connObj.bIntersite = False
Else
connObj.bIntersite = True
End If

Dim dtLastSuccess, strNC, lTemp, strTemp
dtLastSuccess = oReplNeighbor.TimeOfLastSyncSuccess
If Len(dtLastSuccess) &gt;= 14 Then
dtLastSuccess = DateSerial(Mid(dtLastSuccess, 1, 4), Mid(dtLastSuccess, 5, 2), Mid(dtLastSuccess, 7, 2)) + TimeSerial(Mid(dtLastSuccess, 9, 2), Mid(dtLastSuccess, 11, 2), Mid(dtLastSuccess, 13, 2))
End If
If DateSerial(1601, 1, 1) = dtLastSuccess Then
dtLastSuccess = "Never"
End If
connObj.strLastSuccessfulSyncTime = dtLastSuccess
Next
Else
' Decide whether the error indicates that the WMI Provider is not installed
' (one of the following errors: Provider Not Found, Invalid Class, Invalid Object
' or Invalid Namespace) or another more generic error.
If Err.number = &amp;H80041011 Or _
Err.number = &amp;H80041010 Or _
Err.number = &amp;H8004100F Or _
Err.number = &amp;H8004100E Then

' This is to be expected if we are running on Win2K and don't have the
' replication provider installed.
CreateEvent EVENT_ID_REPLPROVINSTALLED, EVENT_TYPE_INFORMATION, _
"The WMI Replication Provider is not installed." &amp; _
GetErrorString(Err.number, Err.Description)
Else
' An error that does not necessarily indicate that the provider is not
' installed has occurred. Generate a generic error event.
CreateEvent EVENT_ID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
SCRIPT_NAME &amp; " cannot determine whether the WMI Replication Provider is installed." &amp; _
GetErrorString(Err.number, Err.Description)
End If
End If
Err.Clear

Dim strDNSName
strDNSName = oRootDSE.Get("defaultNamingContext")

' Create DC instance
Dim oDomainConInstance
Set oDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='Windows!Microsoft.Windows.Server.DC.Computer']$")
oDomainConInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", TargetFQDNComputer
oDiscData.AddInstance oDomainConInstance

' Now walk the collection of ConnObjProperties objects and create discovery objects
For Each connObj In dictConnObj.Items()
Dim oConnObj
Dim oSourceDomainConInstance
Set oConnObj = oDiscData.CreateClassInstance("$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']$")
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.Forest']/Name$", DNSNameFromDN(strDNSName)
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/Name$", GetFlatDomainForDC(connObj.strDnsHostName) &amp; "\" &amp; connObj.strComputerName
Set oSourceDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='Windows!Microsoft.Windows.Server.DC.Computer']$")
oSourceDomainConInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", connObj.strDnsHostName
oDiscData.AddInstance oSourceDomainConInstance
If Err &lt;&gt; 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the flat domain name for '" &amp; connObj.strDnsHostName &amp; "'." &amp; vbCrLf &amp; _
"This will cause an incomplete topology to be displayed." &amp; vbCrLf &amp; _
"The error returned was:" &amp; _
vbCrLf &amp; GetErrorString(Err)
Else
If connObj.iConnectionState &gt;= CONNECTION_ERROR Then
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ConnectionState$", "Red"
ElseIf connObj.iConnectionState &gt;= CONNECTION_WARNING Then
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ConnectionState$", "Yellow"
Else
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ConnectionState$", "Green"
End If

' Automatic or Manual
If connObj.iOptions AND 1 Then
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ManualConnection$", "No"
Else
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ManualConnection$", "Yes"
End If

If connObj.bInterSite Then
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ConnectionStyle$", "Dash"
Else
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ConnectionStyle$", "Solid"
End If

oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ConsecutiveFailures$", 0
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/LastSuccessfulSyncTime$", "Deprecated"
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/OtherPartitionsHeld$", connObj.strNC
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/DomainPartitionsHeld$", connObj.strDomainNC
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ApplicationPartitionsHeld$", connObj.strNDNC
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/TransportType$", connObj.strTransportType
oDiscData.AddInstance oConnObj

Dim oDomainControllerToConnectionObj
Dim oConnectionObjToDomainController
Set oDomainControllerToConnectionObj = oDiscData.CreateRelationshipInstance("$MPElement[Name='AD!Microsoft.Windows.Server.DC.Computer.references.Microsoft.Windows.Server.AD.Library.ConnectionObject']$")
oDomainControllerToConnectionObj.Source = oSourceDomainConInstance
oDomainControllerToConnectionObj.Target = oConnObj
oDiscData.AddInstance oDomainControllerToConnectionObj
Set oConnectionObjToDomainController = oDiscData.CreateRelationshipInstance("$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject.references.Microsoft.Windows.Server.DC.Computer']$")
oConnectionObjToDomainController.Source = oConnObj
oConnectionObjToDomainController.Target = oDomainConInstance
oDiscData.AddInstance oConnectionObjToDomainController
End If
Next

On Error Resume Next
oAPI.Return oDiscData
Discoveryflag = true

If Err &lt;&gt; 0 Then
Wscript.Echo Err.Description &amp; vbCrLf &amp; "(0x" &amp; Hex(Err.number) &amp; ")"
End If
'Wscript.Echo "AD Discovery took " &amp; DateDiff("s", dtStart, Now) &amp; " seconds to complete"
End Sub


Function DNSNameFromDN(sDN)
Dim sDNS
sDNS = Mid(sDN, 4)
sDNS = Replace(sDNS, ",DC=", ".")
DNSNameFromDN = sDNS
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
'
oAPI.LogScriptEvent "AD Remote Topology Discovery", lngEventID, lngEventType, strMessage
End Sub

'******************************************************************************
Function GetErrorString(lErr, strErr)
'
' 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.)
'
On Error Resume Next
If 0 &gt;= 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 = &amp;HFFFF0000
Const HiWord8007 = &amp;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 " &amp; (lErr And LoWordMask))

Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i &lt; 5)

strErr = strMessage
End If
End If
End If

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

'******************************************************************************
Function ParseSchedule(schedule)
'
' Purpose: Parses the schedule data passed in and returns a textual
' representation of the schedule.
'
' Parameters: schedule, an array of bytes read from AD
'
' Return: String, the textual representation of the schedule
'
If IsArray(schedule) Then
Dim i, iSchedule
' Look through the array of bytes, checking that the schedule is valid
' until we get to the interesting bit.
' Format:
' LONG size
' LONG bandwidth
' LONG numberOfSchedules
' schedule data
i = 0

Dim lSize, lBandwidth, lNumSchedules
lSize = GetLong(schedule, i)
lBandwidth = GetLong(schedule, i)
lNumSchedules = GetLong(schedule, i)
' ParseSchedule = ParseSchedule &amp; "Size:" &amp; lSize &amp; vbCrLf &amp; "Bandwidth:" &amp; lBandwidth &amp; vbCrLf &amp; "NumSchedules:" &amp; lNumSchedules &amp; vbCrLf

' For each schedule the format is:
' LONG type
' LONG offset
' LONG scheduleDataEntries (7 * 24)
Dim lType, lOffset
lType = GetLong(schedule, i)
lOffset = GetLong(schedule, i)
' ParseSchedule = ParseSchedule &amp; "Type:" &amp; lType &amp; vbCrLf &amp; "Offset:" &amp; lOffset &amp; vbCrLf

If lOffset &lt;&gt; i Then
' Problem: The offset should be where our index is.
Err.Raise E_INVALIDARG, SCRIPT_NAME &amp; ":ParseSchedule", "Could not parse the schedule correctly. The offset does not match the start of the data."
End If

' Each bit in the low nybble of each byte corresponds to a 15 minute period
Do Until (i &gt;= lOffset + (24 * 7)) Or (i &gt; lSize)

If ((i - lOffset) Mod 24) = 0 Then
ParseSchedule = ParseSchedule &amp; vbCrLf
End If
Dim iHour
iHour = CInt(AscB(MidB(schedule, i + 1, 1))) AND &amp;H0F
' Dim iBitMask, iTimeOffset, iTime
' iBitMask = 1
' Do
' If iHour And iBitMask Then
' ParseSchedule = ParseSchedule &amp; "X"
' Else
' ParseSchedule = ParseSchedule &amp; "O"
' End If
'
' iBitMask = iBitMask * 2
' Loop While iBitMask &lt; 16
If iHour = 0 Then
ParseSchedule = ParseSchedule &amp; "O"
ElseIf iHour = &amp;H0F Then
ParseSchedule = ParseSchedule &amp; "X"
Else
ParseSchedule = ParseSchedule &amp; "P"
End If


i = i + 1
Loop

If (i &gt; lSize) Then
Err.Raise E_INVALIDARG, SCRIPT_NAME &amp; ":ParseSchedule", "Could not parse the schedule correctly. Ran out of data while parsing the schedule."
End If
End If
End Function

'******************************************************************************
Function GetLong(aBytes, ByRef index)
'
' Purpose: Constructs a long value out of a byte array. Starts with the
' value indexed by i + 1. (Array is 1 based.) Increments i past
' the long. NOTE: Does not work for longs with the top bit set.
'
' Arguments: aBytes, the byte array
' index, the index into the array at which to start
'
' Returns: Long, the value constructed.
'
If IsArray(aBytes) Then
If UBound(aBytes) &gt; (index + 4) Then
GetLong = AscB(MidB(aBytes, index + 1, 1)) + _
AscB(MidB(aBytes, index + 2, 1)) * 256 + _
AscB(MidB(aBytes, index + 3, 1)) * 65536

' Can't handle longs with the high bit set.
If 128 &lt;= AscB(MidB(aBytes, index + 4, 1)) Then
' This will produce an incorrect result, but just ignore this case
Else
GetLong = GetLong + AscB(MidB(aBytes, index + 4, 1)) * 16777216
End If

index = index + 4
End If
End If
End Function

'******************************************************************************
Function GetSiteFromDN(strDN)
'
' Purpose: To obtain the site from a DCs DN
'
' Arguments: strDN, the DCs DN
'
' Returns: String, the site name
'
On Error Resume Next

Dim strTemp, lTemp

GetSiteFromDN = ""
strTemp = strDN
lTemp = Instr(strTemp, "CN=Servers,CN=")
If lTemp &gt; 0 Then
' Get the Site, skipping the CN= bit
strTemp = Mid(strTemp, lTemp + Len("CN=Servers,CN="))
lTemp = Instr(strTemp, ",CN=Sites")
If lTemp &gt; 1 Then
GetSiteFromDN = Left(strTemp, lTemp - 1)
End If
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 = "&lt;LDAP://" &amp; strLocalDC &amp; "/" &amp; oRootDSE.Get("ConfigurationNamingContext") &amp; "&gt;;(&amp;(objectCategory=Server)(dnsHostName=" &amp; strDNSHostName &amp; "));serverReference,distinguishedName;subtree"
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to construct the query to find the Server '" &amp; strDNSHostName &amp; "'."
End If

Dim rsServers
Set rsServers = oADOConn.Execute(strQuery)
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query to find the Server '" &amp; strDNSHostName &amp; "'."
End If

Do Until rsServers.EOF or Len(GetFlatDomainForDC) &gt; 0
Dim strDomainDN, strServerRef, iStartDomain
strServerRef = rsServers.Fields("ServerReference")
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get the ServerReference attribute of '" &amp; strDNSHostName &amp; "'."
End If

iStartDomain = Instr(strServerRef, "DC=")
If iStartDomain &gt; 0 Then
strDomainDN = Mid(strServerRef, iStartDomain)

strQuery = "&lt;LDAP://" &amp; strLocalDC &amp; "/" &amp; oRootDSE.Get("ConfigurationNamingContext") &amp; "&gt;;(&amp;(objectCategory=crossRef)(ncName=" &amp; strDomainDN &amp; "));netbiosName,dnsRoot;subtree"
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to construct the query to find the Domain '" &amp; strDomainDN &amp; "'."
End If

Dim rsDomains
Set rsDomains = oADOConn.Execute(strQuery)
If Err &lt;&gt; 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query to find the Domain '" &amp; strDomainDN &amp; "'."
End If

Do Until rsDomains.EOF or Len(GetFlatDomainForDC) &gt; 0
Dim strFlatName
strFlatName = rsDomains.Fields("netbiosName")
If Err &lt;&gt; 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 &gt; 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 &amp; "::GetFlatDomainForDC", "Failed to obtain the flat domain name for '" &amp; strDNSHostName &amp; "'."
End If
End Function
</Script></Contents>
</File>
</Files>
</DataSource>
</Discovery>