Utför AD-identifiering av anslutningsobjektet. Kör alla hanterade DCs
Knowledge Base article:
Sammanfattning
Denna identifieringsregel identifierar fjärranslutningen av ett objekt på varje domänkontrollant. Fjärranslutning av ett objekt är synlig i AD-topologivy.
Konfiguration
Denna identifiering kräver att "Agent Proxy" aktiveras på alla DCs. Se konfigurationsguiden för detaljer.
Denna regel kan inaktiveras om AD-topologivy och den associerade tillgängligheten inte används.
' 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
SVE