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.
' Other Variables
Dim oArgs,SourceType, SourceID, ManagedEntityId, TargetFQDNComputer, TargetNetbiosComputer,IsTargetAgentless, Discoveryflag
Set oArgs = WScript.Arguments
if oArgs.Count < 5 Then
Wscript.Quit -1
End If
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 & 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 <> 0 Then
Wscript.Quit -1
End If
Set oDiscData = oAPI.CreateDiscoveryData (SourceType, SourceID, ManagedEntityId)
If Err <> 0 Then
Wscript.Quit -1
End If
If Not(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
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." & vbCrLf & _
"The script '" & SCRIPT_NAME & "' will not execute." & vbCrLf & _
"To prevent this alert being generated again, either change the monitoring " & _
"mode of the computer '" & TargetFQDNComputer & "' to agent-managed " & _
"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 <> 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 <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to initialize the 'ADSDSOObject'."
End If
Set oRootDSE = GetObject("LDAP://" & strLocalDC & "/RootDSE")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get 'LDAP://RootDSE'."
End If
Dim strQuery
strQuery = "<LDAP://" & strLocalDC & "/" & oRootDSE.Get("ConfigurationNamingContext") & ">;(&(objectCategory=Server)(cn=" & TargetNetbiosComputer & "));adspath,distinguishedName;subtree"
If Err <> 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 <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query '" & strQuery & "'."
End If
Do Until rsServers.EOF
Set oNTDSSettings = GetObject("LDAP://" & strLocalDC & "/CN=NTDS Settings," & rsServers.Fields("distinguishedName"))
If Err = 0 Then
Exit Do
End If
Err.Clear
rsServers.MoveNext
Loop
If Err <> 0 Or rsServers.EOF Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to find the server object for '" & strLocalDC & "'."
End If
Err.Clear
strLocalSite = GetSiteFromDN(rsServers.Fields("distinguishedName"))
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get the site name for '" & strLocalDC & "'."
End If
strQuery = "<" & rsServers.Fields("adspath") & ">;(objectCategory=ntdsconnection);fromServer,cn,adspath,mS-DS-ReplicatesNCReason,options,transportType;subtree"
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to construct the query to find the connection objects for '" & strLocalDC & "'."
End If
Dim rsConnObjs
Set rsConnObjs = oADOConn.Execute(strQuery)
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to execute the query '" & strQuery & "'."
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://" & rsConnObjs.Fields("fromServer"))
if Err.number <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get '" & "LDAP://" & rsConnObjs.Fields("fromServer") & "'."
End If
Set oParent = GetObject(oNTDSSettings.Parent)
if Err.number <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to bind to '" & oNTDSSettings.Parent & "'."
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 = "<LDAP://" & strLocalDC & "/" & oRootDSE.Get("ConfigurationNamingContext") & ">;(&(objectCategory=crossRef)(nCName=" & oNCReason.DNString & ")(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 & vbCrLf & oNCReason.DNString
ElseIf bIsDomainNC Then
connObj.strDomainNC = connObj.strDomainNC & vbCrLf & oNCReason.DNString
Else
connObj.strNC = connObj.strNC & vbCrLf & oNCReason.DNString
End IF
Next
End If
If Len(rsConnObjs.Fields("TransportType")) > 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:\\" & strLocalDC & "\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 > 2 Then
If connObj.iConnectionState < CONNECTION_ERROR Then
connObj.iConnectionState = CONNECTION_ERROR
End If
ElseIf oReplNeighbor.ModifiedNumConsecutiveSyncFailures > 0 Then
If connObj.iConnectionState < CONNECTION_WARNING Then
connObj.iConnectionState = CONNECTION_WARNING
End If
Else
If connObj.iConnectionState < CONNECTION_OKAY Then
connObj.iConnectionState = CONNECTION_OKAY
End If
End If
If connObj.iConsecutiveFailures < 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) >= 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 = &H80041011 Or _
Err.number = &H80041010 Or _
Err.number = &H8004100F Or _
Err.number = &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." & _
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 & " cannot determine whether the WMI Replication Provider is installed." & _
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) & "\" & 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 <> 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"Failed to get the flat domain name for '" & connObj.strDnsHostName & "'." & vbCrLf & _
"This will cause an incomplete topology to be displayed." & vbCrLf & _
"The error returned was:" & _
vbCrLf & GetErrorString(Err)
Else
If connObj.iConnectionState >= CONNECTION_ERROR Then
oConnObj.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.ConnectionObject']/ConnectionState$", "Red"
ElseIf connObj.iConnectionState >= 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
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 <> 0 Then
Wscript.Echo Err.Description & vbCrLf & "(0x" & Hex(Err.number) & ")"
End If
'Wscript.Echo "AD Discovery took " & DateDiff("s", dtStart, Now) & " 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 >= 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 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 & "Size:" & lSize & vbCrLf & "Bandwidth:" & lBandwidth & vbCrLf & "NumSchedules:" & lNumSchedules & 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 & "Type:" & lType & vbCrLf & "Offset:" & lOffset & vbCrLf
If lOffset <> i Then
' Problem: The offset should be where our index is.
Err.Raise E_INVALIDARG, SCRIPT_NAME & ":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 >= lOffset + (24 * 7)) Or (i > lSize)
If ((i - lOffset) Mod 24) = 0 Then
ParseSchedule = ParseSchedule & vbCrLf
End If
Dim iHour
iHour = CInt(AscB(MidB(schedule, i + 1, 1))) AND &H0F
' Dim iBitMask, iTimeOffset, iTime
' iBitMask = 1
' Do
' If iHour And iBitMask Then
' ParseSchedule = ParseSchedule & "X"
' Else
' ParseSchedule = ParseSchedule & "O"
' End If
'
' iBitMask = iBitMask * 2
' Loop While iBitMask < 16
If iHour = 0 Then
ParseSchedule = ParseSchedule & "O"
ElseIf iHour = &H0F Then
ParseSchedule = ParseSchedule & "X"
Else
ParseSchedule = ParseSchedule & "P"
End If
i = i + 1
Loop
If (i > lSize) Then
Err.Raise E_INVALIDARG, SCRIPT_NAME & ":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) > (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 <= 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 > 0 Then
' Get the Site, skipping the CN= bit
strTemp = Mid(strTemp, lTemp + Len("CN=Servers,CN="))
lTemp = Instr(strTemp, ",CN=Sites")
If lTemp > 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 = "<LDAP://" & strLocalDC & "/" & 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://" & strLocalDC & "/" & 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></Contents>
</File>
</Files>
</DataSource>
</Discovery>
Home
ENU