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
oAPI.LogScriptEvent EventSource, 501, EventSeverityError, "Script API error: Failed to create DiscoveryData object."
wScript.Quit -1
End If
If FilterADVersion() <> 0 Then 'This function filters AD version to discover
oAPI.Return oDiscData
Exit Sub
End If
Dim oForestDNSRoot, oForestSchemaRoot
Set oRootDSE = GetObject("LDAP://" & sTargetComputer & "/RootDSE")
strDNSName = oRootDSE.Get("rootDomainNamingContext")
Set oForestDNSRoot = GetObject("LDAP://" & oRootDSE.Get("rootDomainNamingContext"))
strForestDNSRoot = GetDNSName(oForestDNSRoot.Get("fSMORoleOwner"))
Set oForestSchemaRoot = GetObject("LDAP://" & oRootDSE.Get("schemaNamingContext"))
strForestSchemaRoot = GetDNSName(oForestSchemaRoot.Get("fSMORoleOwner"))
Dim oDomain, oDNC, oRID, oInfra, oParentDomain, ParentDomain
sDNC = oRootDSE.Get("defaultNamingContext")
oDNC = Null
Set oDNC = GetObject("LDAP://" & sDNC)
If Not IsNull(oDNC) Then
sPDC = GetDNSName(oDNC.Get("fSMORoleOwner"))
Set oRID = GetObject("LDAP://CN=RID Manager$,CN=System," & sDNC)
sRID = GetDNSName(oRID.Get("fSMORoleOwner"))
Set oInfra = GetObject("LDAP://CN=Infrastructure," & sDNC)
sInfra = GetDNSName(oInfra.Get("fSMORoleOwner"))
Set oDomain = GetObject("LDAP://CN=Partitions,CN=Configuration," & sDNC)
sDomain = GetDNSName(oDomain.Get("fSMORoleOwner"))
End If
Err.Clear
Set oADOConn = CreateObject("ADODB.Connection")
If Err <> 0 Then
oAPI.LogScriptEvent EventSource, 504, EventSeverityWarning, "Failed to create ADODB.Connection - DC discovery fails to determine properties of DC"
Else
oADOConn.Provider = "ADSDsOObject"
oADOConn.Open "ADs Provider"
If Err <> 0 Then
oAPI.LogScriptEvent EventSource, 505, EventSeverityWarning, "Failed to open ADs Provider - DC discovery fails to determine properties of DC"
Else
' Get all the DCs in this Domain
If Not IsNull(oDNC) Then
strQuery = "<LDAP://" & sPDC & "/OU=Domain Controllers," & sDNC & ">;(&(objectCategory=computer)(cn=" & NetbiosName & "));cn,distinguishedName,dNSHostName,serverReferenceBL,userAccountControl;subtree"
Set domainControllers = oADOConn.Execute(strQuery)
If Err.Number <> 0 Then
oAPI.LogScriptEvent EventSource, 505, EventSeverityWarning, "Failed to query LDAP - DC discovery fails to determine properties of DC - query is " & strQuery
Else
Err.Clear
While Not domainControllers.EOF
Set sServerReferences = domainControllers.Fields("serverReferenceBL")
For Each sServerReference In sServerReferences.value
Set oServerIns = GetObject("LDAP://CN=NTDS Settings," & sServerReference)
If IsGC(oServerIns) Then
IsGlobalCatalogServer = "True"
Else
IsGlobalCatalogServer = "False"
End If
Exit For
Next
sCN = domainControllers.Fields("cn")
userAccountControl = domainControllers.Fields("userAccountControl")
domainControllers.MoveNext
Wend
End If
End If
End If
End If
Dim iEssentialDiscResult
iEssentialDiscResult = -1
If CreateDCGCDiscInstance(IsGlobalCatalogServer, oDiscData, sTargetComputer, sCN, sInfra, sRID, sPDC, sDomain, strForestSchemaRoot, userAccountControl) = 0 Then '//We instantiate essential services iff DC/GC instance gets created first
iEssentialDiscResult = DiscoverEssentialServiceInstances(oRootDSE, oDiscData, sTargetComputer, sCN)
End If
If iEssentialDiscResult <> 0 Then '//there was error in essential service instances discovery
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_ERROR, "Essential service discovery failed. Discovery script for DC/GC role and essential services quit" '//Kye: need to validate error message string
wScript.Quit -1
End If
oAPI.Return oDiscData
End Sub '//Main()
'//**************************************************************
'// DiscoverEssentialServiceInstances
'// This is the main entry for Essentail Service instances
'// creation
'//**************************************************************
Function DiscoverEssentialServiceInstances(ByRef oRootDSE, ByRef oDiscData, ByRef sTargetComputer, ByRef sCN)
Dim iResult
Dim discList
Dim i, j
Dim instList
discList = PrepareDiscoveryList(oRootDSE, sTargetComputer, sCN)
If IsNull(discList) Then '//error has occurred
iResult = 1
Else
ReDim instList(UBound(discList))
For i = 0 To UBound(discList) - 1
Set instList(i) = oDiscData.CreateClassInstance(discList(i).strInstanceGUID)
For j = 0 To discList(i).iCount - 1
instList(i).AddProperty discList(i).Property(j).strGUID, discList(i).Property(j).strValue
Next
oDiscData.AddInstance (instList(i))
Next
iResult = 0
End If
DiscoverEssentialServiceInstances = iResult
End Function
'//**************************************************************
'// GetDomainFuncMode
'// Returns
'// -1: Error
'// 0: only NTFRS needed
'// 1: only DFSR needed
'// 2: both NTFSR and DFSR needed
'//**************************************************************
Private Function GetDomainFuncMode(ByRef oRootDSE)
Dim bSuccess
Dim iResult '//this variable will hold the return value above
Dim lDomainFunctionality
lDomainFunctionality = oRootDSE.Get("domainFunctionality")
If 0 <> Err.Number Then
lDomainFunctionality = 0
End If
Err.Clear
If lDomainFunctionality > 2 Then '//We are in Longhorn Domain Mode, so read the reg key to determine the correct service
Dim oReg, strValue
strValue = -1
Set oReg = CreateObject("WScript.Shell")
If Err <> 0 Then
strMessage = "The script '" & SCRIPT_NAME & "' failed while create a registry handle." & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
iResult = -1
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, strMessage
Else
strValue = oReg.RegRead(REGKEY_SYSVOL_STATE)
If Err.Number = 0 Then '//If success Or the key does not exist
If strValue = "1" Or strValue = "2" Then
iResult = 2
ElseIf strValue = "0" Or strValue = "4" Or strValue = "5" Or strValue = "9" Then
iResult = 0
ElseIf strValue = "3" Or strValue = "6" Or strValue = "7" Or strValue = "8" Then
iResult = 1
Else
iResult = -1
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
"The script '" & SCRIPT_NAME & "' " & vbCrLf & _
"read a registry value which is not valid for domain functional mode '" & REGKEY_SYSVOL_STATE & _
"'. The error returned was " & GetErrorString(Err.Number, Err.Description)
End If
Else
iResult = -1
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
"The script '" & SCRIPT_NAME & "' " & vbCrLf & _
"failed to read the registry key '" & REGKEY_SYSVOL_STATE & _
"'. The error returned was " & GetErrorString(Err.Number, Err.Description)
End If
End If
Else
' We are in Win2k/Win2k3 Domain Mode, so just check NTFRS
iResult = 0
End If
GetDomainFuncMode = iResult
End Function
Sub OpenWMIService()
On Error Resume Next
Err.Clear
If IsEmpty(objWMIService) Then
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
".\root\cimv2")
If Err.Number <> 0 Then
wScript.Quit
End If
End If
End Sub
Function GetServiceStatus(ServiceName)
Dim objService, objItem
Set objService = objWMIService.ExecQuery("Select * from Win32_Service where Name ='" + ServiceName + "'", , 48)
For Each objItem In objService
GetServiceStatus = objItem.State + ", " + objItem.StartMode
Next
End Function
'******************************************************************************
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.Number, Err.Description)
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
Function DNSNameFromDN(sDN)
sDN = Replace(sDN, ".", ",DC=")
sDN = "DC=" & sDN
DNSNameFromDN = sDN
End Function
Function GetDNSName(sPath)
Dim oNTDS, oServer
Set oNTDS = GetObject("LDAP://" & sPath)
Set oServer = GetObject(oNTDS.Parent)
GetDNSName = oServer.Get("dNSHostName")
End Function
Class PropertyValuePair
Public strGUID
Public strValue
Sub Init(ByRef guid, ByRef val)
strGUID = guid
strValue = val
End Sub
End Class
Class InstanceType
Public strInstanceGUID
Public iCount
Public Property
Sub Init(ByRef strGUID, ByRef arrayPropGuid, ByRef arrayPropVal)
Dim i
If UBound(arrayPropGuid) <> UBound(arrayPropVal) Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "Essential service discovery failed. Number of Property GUID and value don't match" '//Kye: need to validate error message string
wScript.Quit -1
End If
strInstanceGUID = strGUID
iCount = UBound(arrayPropGuid)
ReDim Property(iCount)
For i = 0 To iCount - 1
Set Property(i) = New PropertyValuePair
Property(i).Init arrayPropGUID(i), arrayPropVal(i)
Next
End Sub
End Class
Function CreateInstanceTypeObject(ByRef strGUID, ByRef arrayPropGuid, ByRef arrayPropVal)
Dim oInstance
Set oInstance = New InstanceType
oInstance.Init strGUID, arrayPropGuid, arrayPropVal
Set CreateInstanceTypeObject = oInstance
End Function
'//**************************************************************
'// GetEssentialServicesCount
'// This function gives number of essential services for each version of AD
'// (+1) means we may need one more service in case if we need DFSR/NTFRS together
'// however, this function doesn't provide the +1 case, it just returns base number only
'// The +1 part will be determined in PrepareDiscoveryList() function
'// Win2K : 7
'// Win2K3 : 7 (+1)
'// Win2K8 : 8 (+1)
'//**************************************************************
Function GetEssentialServicesCount(ByVal version)
Dim iResult
Select Case version
Case 2000
iResult = 6
Case 2003
iResult = 6
Case 2008
iResult = 7
End Select
GetEssentialServicesCount = iResult
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 "ADLocalDiscoveryDC.vbs", lngEventID, lngEventType, strMessage
End Sub
Call Main
'******************************************************************************
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 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
'//**************************************************************
'// FilterADVersion
'// * 0: indicate current box has the correct version that this script is targetting to
'// * 1: otherwise
'//**************************************************************
Function FilterADVersion()
Dim iResult
Set oShell = CreateObject("WScript.Shell")
iResult = 1
version = oShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
If Err <> 0 Then
oAPI.LogScriptEvent EventSource, 502, EventSeverityError, "Determine OS version: Failed to access key SOFTWARE\Microsoft\Windows NT\CurrentVersion"
Else
If version = "6.0" Or version = "6.1" Then
iResult = 0
End If
End If
FilterADVersion = iResult
End Function
'//**************************************************************
'// Discovery For Windows 2008 DC/GC role
'//**************************************************************
Function CreateDCGCDiscInstance(ByRef IsGlobalCatalogServer, ByRef oDiscData, ByRef sTargetComputer, ByRef sCN, ByRef sInfra, ByRef sRID, ByRef sPDC, ByRef sDomain, ByRef strForestSchemaRoot, ByRef userAccountControl)
Dim iResult
iResult = -1
If IsGlobalCatalogServer = "True" Then
Set oDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.DomainControllerRole']$")
oDomainConInstance.AddProperty "$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.DomainControllerRole']/IsGlobalCatalogServer$", IsGlobalCatalogServer
Else
Set oDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.DomainControllerRole']$")
oDomainConInstance.AddProperty "$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.DomainControllerRole']/IsGlobalCatalogServer$", IsGlobalCatalogServer
End If
' NOTE: Temp workaround - We should update the Version Number below everytime we rev the MP Version.
dim mpVersion
mpVersion = "1.0.46.0"
oDomainConInstance.AddProperty "$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.DomainControllerRole']/ManagementPackVersion$", mpVersion
oDiscData.AddInstance (oDomainConInstance)
iResult = 0
CreateDCGCDiscInstance = iResult
End Function
Sub AddPropertyIfNotNull(ByRef discData, prop, value)
If Not IsNull(value) Then
Call discData.AddProperty(prop, value)
End If
End Sub
'/**************************************************************
' TestRODC
'**************************************************************/
Function TestRODC()
Dim strResult
strResult = "False"
arrCapaList = oRootDSE.Get("SupportedCapabilities")
If IsArray(arrCapaList) Then
Dim strOid
For Each strOid In arrCapaList
If strOid = LDAP_CAP_ACTIVE_DIRECTORY_PARTIAL_SECRETS_OID Then
strResult = "True"
Exit For
End If
Next
End If
TestRODC = strResult
End Function
'//**************************************************************
'// PrepareDiscoveryList For Windows 2008 DC Essential Services
'// Initializes list with needed Essentail Service instances
'//**************************************************************
Function PrepareDiscoveryList(ByRef oRootDSE, ByRef sTargetComputer, ByRef sCN)
Dim iDomainFuncMode
Dim i
Dim iServiceCount
iServiceCount = GetEssentialServicesCount(2008)
Dim discList
Dim arrayPropGuid(3)
Dim arrayPropValue(3)
arrayPropGuid(0) = "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$"
arrayPropValue(0) = sTargetComputer
arrayPropGuid(1) = "$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.DomainControllerRole']/Name$"
arrayPropValue(1) = sCN
arrayPropGuid(2) = "$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']/Name$"
'/* Check domain function mode and add types properly to the queue */
iDomainFuncMode = GetDomainFuncMode(oRootDSE)
If iDomainFuncMode < 0 Then '//Error occurred
List = Nothing
Else
i = 0
Select Case iDomainFuncMode
Case 0
ReDim discList(iServiceCount)
arrayPropValue(2) = "NTFRS"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
Case 1
ReDim discList(iServiceCount)
arrayPropValue(2) = "DFSR"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
Case 2
ReDim discList(iServiceCount + 1) '//we need ntfrs and dfsr both
arrayPropValue(2) = "NTFRS"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "DFSR"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
End Select
End If
'/* Enqueue common discovery types */
arrayPropValue(2) = "NTDS"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "KDC"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "NetLogon"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "W32Time"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "ISM"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "SysVol"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='KnowledgeServicesADLibrary!Microsoft.KnowledgeServices.Windows.Server.2008.AD.EssentialService']$", arrayPropGuid, arrayPropValue)
PrepareDiscoveryList = discList
End Function
'---------------------------------------------------------------------------
'This function discovers the InstanceId property
'---------------------------------------------------------------------------
Sub GetADSharesInfo(ByRef sysvol, ByRef netlogon)
sysvol = ""
netlogon = ""
Dim objWin32Shares, objShare
Set objWin32Shares = objWMIService.ExecQuery("Select * from Win32_Share Where Name = 'SYSVOL' OR Name = 'NETLOGON'")
For Each objShare In objWin32Shares
If IsNull(objShare) = False Then
If UCase(objShare.Name) = "SYSVOL" Then
sysvol = objShare.Path
End If
If UCase(objShare.Name) = "NETLOGON" Then
netlogon = objShare.Path
End If
End If
Next
End Sub
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 TypeName(arrDNSRoots) = "String" 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></ScriptBody>
<TimeoutSeconds>300</TimeoutSeconds>
<IntervalInSeconds>44086</IntervalInSeconds>
</DataSource>
</Discovery>
Home