Windows Server Active Directory 2012 R2 資料來源模組

Microsoft.Windows.Server.AD.2012.R2.Discovery.DataSource (DataSourceModuleType)

此模組會探索 Microsoft Windows Server 2012 R2 伺服器中的 Windows Server Active Directory 角色

Knowledge Base article:

Microsoft Windows Server 2012 R2 AD 資料來源模組

此模組會在 Microsoft Windows Server 2012 R2 電腦中實作 Active Directory 角色的探索

Element properties:

TypeDataSourceModuleType
IsolationAny
AccessibilityInternal
RunAsSystem.PrivilegedMonitoringAccount
OutputTypeSystem.Discovery.Data

Member Modules:

ID Module Type TypeId RunAs 
Scheduler DataSource System.Discovery.Scheduler Default
RegistryProbe ProbeAction Microsoft.Windows.RegistryProbe Default
ScriptProbe ProbeAction Microsoft.Windows.ScriptDiscoveryProbe Default
WMIProbe ProbeAction Microsoft.Windows.WmiProbe Default
Filter ConditionDetection System.ExpressionFilter Default
Filter2 ConditionDetection System.ExpressionFilter Default

Overrideable Parameters:

IDParameterTypeSelectorDisplay NameDescription
IntervalSecondsint$Config/IntervalSeconds$間隔秒數模組的執行頻率 (以秒為單位)。
TimeoutSecondsint$Config/TimeoutSeconds$逾時秒數模組等待完成執行的預期時間 (以秒為單位)。

Source Code:

<DataSourceModuleType ID="Microsoft.Windows.Server.AD.2012.R2.Discovery.DataSource" RunAs="System!System.PrivilegedMonitoringAccount" Accessibility="Internal">
<Configuration>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" minOccurs="1" name="IntervalSeconds" type="xsd:unsignedInt"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" minOccurs="1" name="TimeoutSeconds" type="xsd:unsignedInt"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" minOccurs="1" name="SourceId" type="xsd:string"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" Selector="$Config/IntervalSeconds$" ParameterType="int"/>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
</OverrideableParameters>
<ModuleImplementation Isolation="Any">
<Composite>
<MemberModules>
<DataSource ID="Scheduler" TypeID="System!System.Discovery.Scheduler">
<Scheduler>
<SimpleReccuringSchedule>
<Interval Unit="Seconds">$Config/IntervalSeconds$</Interval>
</SimpleReccuringSchedule>
<ExcludeDates/>
</Scheduler>
</DataSource>
<ProbeAction ID="RegistryProbe" TypeID="Windows!Microsoft.Windows.RegistryProbe">
<ComputerName>$Target/Property[Type='Windows!Microsoft.Windows.Computer']/NetworkName$</ComputerName>
<RegistryAttributeDefinitions>
<RegistryAttributeDefinition>
<AttributeName>WindowsCurrentVersion</AttributeName>
<Path>SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion</Path>
<PathType>1</PathType>
<AttributeType>1</AttributeType>
</RegistryAttributeDefinition>
</RegistryAttributeDefinitions>
</ProbeAction>
<ProbeAction ID="ScriptProbe" TypeID="Windows!Microsoft.Windows.ScriptDiscoveryProbe">
<ScriptName>ADLocalDiscovery.vbs</ScriptName>
<Arguments>"0" "$Config/SourceId$" "$Target/Id$" "$Target/Property[Type="Windows!Microsoft.Windows.Computer"]/PrincipalName$" "$Target/Property[Type="Windows!Microsoft.Windows.Computer"]/NetbiosComputerName$"</Arguments>
<ScriptBody><Script>'*************************************************************************
' Script Name - AD Local Discovery DC
'
' Purpose - Discovers whether a local server is DC or not
'
' Parameters - Targer fqdn, netbiosname
'
' (c) Copyright 2014, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************

Option Explicit

SetLocale("en-us")

Const EVENT_TYPE_SUCCESS = 0
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4

Const EVENTID_SCRIPT_ERROR = 1000

Const PERFORMANCE_DATA_TYPE = 2
Const STATE_DATA_TYPE = 3

'Other constants
Const SCRIPT_NAME = "ADLocalDiscovery"
Const REGKEY_SYSVOL_STATE = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\DFSR\Parameters\SysVols\Migrating SysVols\Local State"
Const ERROR_FILENOTFOUND = &amp;H80070002
Const ESSENTIAL_SERVICE_PROPERTY_COUNT = 3
Const LDAP_CAP_ACTIVE_DIRECTORY_PARTIAL_SECRETS_OID = "1.2.840.113556.1.4.1920"

Dim oRootDSE, oADOConn, oAPI,oDiscData

Sub Main()
On Error Resume Next

'Variables
Dim oArgs,TargetFQDNComputer,SourceType,SourceID,ManagedEntityId,TargetNetbiosName
Dim sTargetComputer, NetbiosName, version, iDomainFuncMode, Discoveryflag

Dim strForestDNSRoot,strForestSchemaRoot,strDNSName
Dim sPDC, sRID, sInfra, IsGlobalCatalogServer, sCN, sDomain
Dim domainControllers,oDomainConInstance,oDomainConToComputerInstance,oServerIns,sServerReferences,sServerReference,sDomainName

' MOMScript API LogScript Error level
const EventSeverityError = 1
const EventSeverityWarning = 2
const EventSeverityInfo = 4
const EventSource = "AD MP DC Local Discovery"

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)
TargetNetbiosName = oArgs(4)
Discoveryflag = false

' Initalize Variables
strForestDNSRoot = ""
strForestSchemaRoot = ""
strDNSName = ""
sPDC = ""
sRID = ""
sInfra = ""
IsGlobalCatalogServer = ""
sCN = TargetFQDNComputer

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
oAPI.LogScriptEvent EventSource, 501, EventSeverityError, "Script API error: Failed to create DiscoveryData object."
Wscript.Quit -1
End if

sTargetComputer =TargetFQDNComputer
NetbiosName = TargetNetbiosName

Dim oForestDNSRoot, oForestSchemaRoot
Set oRootDSE = GetObject("LDAP://" &amp; sTargetComputer &amp; "/RootDSE")
strDNSName = oRootDSE.Get("defaultNamingContext")
Set oForestDNSRoot = GetObject("LDAP://" &amp; oRootDSE.Get("defaultNamingContext"))
strForestDNSRoot = GetDNSName(oForestDNSRoot.Get("fSMORoleOwner"))
Set oForestSchemaRoot = GetObject("LDAP://" &amp; oRootDSE.Get("schemaNamingContext"))
strForestSchemaRoot = GetDNSName(oForestSchemaRoot.Get("fSMORoleOwner"))

Dim oDomain, oDNC, oRID, oInfra, oParentDomain, ParentDomain, sConfigNC, sDNC
sDNC = oRootDSE.Get("defaultNamingContext")
sConfigNC = oRootDSE.Get("configurationNamingContext")
oDNC = null
Set oDNC = GetObject("LDAP://" &amp; sDNC)
if Not IsNull(oDNC) Then
sPDC = GetDNSName(oDNC.Get("fSMORoleOwner"))
Set oRID = GetObject("LDAP://CN=RID Manager$,CN=System," &amp; sDNC)
sRID = GetDNSName(oRID.Get("fSMORoleOwner"))
Set oInfra = GetObject("LDAP://CN=Infrastructure," &amp; sDNC)
sInfra = GetDNSName(oInfra.Get("fSMORoleOwner"))
Set oDomain = GetObject("LDAP://CN=Partitions," &amp; sConfigNC)
sDomain = GetDNSName(oDomain.Get("fSMORoleOwner"))
End if
Err.Clear

Set oADOConn = CreateObject("ADODB.Connection")
Dim strQuery
If Err &lt;&gt; 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 &lt;&gt; 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 = "&lt;LDAP://"&amp; sPDC &amp; "&gt;;(&amp;(objectCategory=computer)(cn="&amp; NetbiosName &amp;"));cn,distinguishedName,dNSHostName,serverReferenceBL;subtree"
Set domainControllers = oADOConn.Execute(strQuery)
if Err.number &lt;&gt; 0 Then
oAPI.LogScriptEvent EventSource, 505, EventSeverityWarning, "Failed to query LDAP - DC discovery fails to determine properties of DC - query is " &amp; 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,"&amp; sServerReference)
if IsGC(oServerIns) Then
IsGlobalCatalogServer = "True"
else
IsGlobalCatalogServer = "False"
end if
Exit For
Next
sCN = domainControllers.Fields("cn")
domainControllers.MoveNext
wend
End If
End if
End if
End if

iDomainFuncMode = GetDomainFuncMode(oRootDSE)

If CreateDCGCDiscInstance(iDomainFuncMode, IsGlobalCatalogServer, oDiscData, sTargetComputer, sCN, sInfra, sRID, sPDC, sDomain, strForestSchemaRoot) &lt;&gt; 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_ERROR, "Active Directory DC / GC discovery failed! The error returned was " &amp; GetErrorString(Err.Number, Err.Description)
WScript.Quit -1
End If

oAPI.Return oDiscData
End Sub '//Main()

'//**************************************************************
'// 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 &lt;&gt; Err.Number Then
lDomainFunctionality = 0
End If
Err.Clear
If lDomainFunctionality &gt; 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 &lt;&gt; 0 Then
strMessage = "The script '" &amp; SCRIPT_NAME &amp; "' failed while create a registry handle." &amp; _
vbCrLf &amp; 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 '" &amp; SCRIPT_NAME &amp; "' " &amp; vbCrLf &amp; _
"read a registry value which is not valid for domain functional mode '" &amp; REGKEY_SYSVOL_STATE &amp; _
"'. The error returned was " &amp; GetErrorString(Err.Number, Err.Description)
End If
Else
iResult = -1
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
"The script '" &amp; SCRIPT_NAME &amp; "' " &amp; vbCrLf &amp; _
"failed to read the registry key '" &amp; REGKEY_SYSVOL_STATE &amp; _
"'. The error returned was " &amp; 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

'----------------------------------------------------------------------------------------------------------------------------------
Class Registry
Public HKEY_CLASSES_ROOT
Public HKEY_CURRENT_USER
Public HKEY_LOCAL_MACHINE
Public HKEY_USERS
Public HKEY_CURRENT_CONFIG
Public HKEY_DYN_DATA

Public ERROR_ACCESS_DENIED
Public ERROR_KEY_NOT_FOUND
Public ERROR_VALUE_NOT_FOUND
Public SUCCESS

Private m_oReg
Private m_lHive

Private Sub Class_Initialize()
HKEY_CLASSES_ROOT = &amp;H80000000
HKEY_CURRENT_USER = &amp;H80000001
HKEY_LOCAL_MACHINE = &amp;H80000002
HKEY_USERS = &amp;H80000003
HKEY_CURRENT_CONFIG = &amp;H80000005
HKEY_DYN_DATA = &amp;H80000006

ERROR_ACCESS_DENIED = 5
ERROR_KEY_NOT_FOUND = 2
ERROR_VALUE_NOT_FOUND = 1
SUCCESS = 0

m_lHive = HKEY_LOCAL_MACHINE
End Sub

Public Sub Connect(ByVal sHostName)
Set m_oReg = GetObject("winmgmts://" &amp; sHostName &amp; "/root/default:StdRegProv")
End Sub

Public Property Get Hive()
Hive = m_lHive
End Property

Public Property Let Hive(ByVal lHive)
m_lHive = lHive
End Property

Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim lValue
lResult = m_oReg.GetDWORDValue(m_lHive, sKeyPath, sValueName, lValue)
ReadDWORDValue = lValue
End Function

Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim sValue
lResult = m_oReg.GetStringValue(m_lHive, sKeyPath, sValueName, sValue)
ReadStringValue = sValue
End Function

Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aValues
lResult = m_oReg.GetMultiStringValue(m_lHive, sKeyPath, sValueName, aValues)
ReadMultiStringValue = aValues
End Function

Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
Dim aSubKeys
lResult = m_oReg.EnumKey(m_lHive, sKeyPath, aSubKeys)
EnumKeys = aSubKeys
End Function

Public Function CreateKey(ByVal sKeyPath)
CreateKey = m_oReg.CreateKey(m_lHive, sKeyPath)
End Function

Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
WriteStringValue = m_oReg.SetStringValue(m_lHive, sKeyPath, sValueName, sValue)
End Function

Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
DeleteValue = m_oReg.DeleteValue(m_lHive, sKeyPath, sValueName)
End Function

Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aData
lResult = m_oReg.GetBinaryValue(m_lHive, sKeyPath, sValueName, aData)
ReadBinaryValue = aData
End Function
End Class ' Registry

'----------------------------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------------------

Class SafeRegistry
Private m_oError
Private m_oRegistry
Private m_sHive
Private m_lSuppressionFlags
Private m_sHost

Public SUPPRESS_KEY_NOT_FOUND
Public SUPPRESS_VALUE_NOT_FOUND
Public SUPPRESS_ACCESS_DENIED
Public SUPPRESS_ALL

Public HKEY_CLASSES_ROOT
Public HKEY_CURRENT_USER
Public HKEY_LOCAL_MACHINE
Public HKEY_USERS
Public HKEY_CURRENT_CONFIG
Public HKEY_DYN_DATA

Public ERROR_ACCESS_DENIED
Public ERROR_KEY_NOT_FOUND
Public ERROR_VALUE_NOT_FOUND
Public SUCCESS

Private DEFAULT_VALUE_NAME

Private Sub Class_Initialize()
Set m_oError = New Error
Set m_oRegistry = New Registry

SUPPRESS_KEY_NOT_FOUND = &amp;H00000001
SUPPRESS_VALUE_NOT_FOUND = &amp;H00000002
SUPPRESS_ACCESS_DENIED = &amp;H00000004
SUPPRESS_ALL = &amp;HFFFFFFFF

HKEY_CLASSES_ROOT = m_oRegistry.HKEY_CLASSES_ROOT
HKEY_CURRENT_USER = m_oRegistry.HKEY_CURRENT_USER
HKEY_LOCAL_MACHINE = m_oRegistry.HKEY_LOCAL_MACHINE
HKEY_USERS = m_oRegistry.HKEY_USERS
HKEY_CURRENT_CONFIG = m_oRegistry.HKEY_CURRENT_CONFIG
HKEY_DYN_DATA = m_oRegistry.HKEY_DYN_DATA

ERROR_ACCESS_DENIED = m_oRegistry.ERROR_ACCESS_DENIED
ERROR_KEY_NOT_FOUND = m_oRegistry.ERROR_KEY_NOT_FOUND
ERROR_VALUE_NOT_FOUND = m_oRegistry.ERROR_VALUE_NOT_FOUND
SUCCESS = m_oRegistry.SUCCESS

DEFAULT_VALUE_NAME = "(Default)"

m_lSuppressionFlags = 0
Hive = HKEY_LOCAL_MACHINE
End Sub

Public Function Connect(ByVal sHostName)
Connect = False
m_sHost = sHostName
On Error Resume Next
m_oRegistry.Connect sHostName
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort "Failed to connect to the WMI registry provider on " &amp; sHostName , m_oError
Else
Connect = True
End If
End Function

Public Property Get Hive()
Hive = m_oRegistry.Hive
End Property

Public Property Let Hive(ByVal lHive)
Select Case lHive
Case HKEY_CLASSES_ROOT
m_sHive = "HKCR"
Case HKEY_CURRENT_USER
m_sHive = "HKCU"
Case HKEY_LOCAL_MACHINE
m_sHive = "HKLM"
Case HKEY_USERS
m_sHive = "HKU"
Case HKEY_CURRENT_CONFIG
m_sHive = "HKCC"
Case HKEY_DYN_DATA
m_sHive = "HKDD"
Case Else
m_sHive = "Invalid"
End Select
m_oRegistry.Hive = lHive
End Property

Public Property Let SuppressionFlags(ByVal lValue)
m_lSuppressionFlags = lValue
End Property

Public Property Get SuppressionFlags()
SuppressionFlags = m_lSuppressionFlags
End Property

Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadDWORDValue = Null

On Error Resume Next
ReadDWORDValue = m_oRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If

HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function

Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadStringValue = Null

On Error Resume Next
ReadStringValue = m_oRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If

HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function

Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadMultiStringValue = Null

On Error Resume Next
ReadMultiStringValue = m_oRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If

HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function

Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
EnumKeys = Null

On Error Resume Next
EnumKeys = m_oRegistry.EnumKeys(sKeyPath, lResult)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath), m_oError
Exit Function
End If

HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
End Function

Public Function CreateKey(ByVal sKeyPath)
Dim lResult
On Error Resume next
lResult = m_oRegistry.CreateKey(sKeyPath)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_CREATING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath), m_oError
Exit Function
End If

HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
CreateKey = lResult
End Function

Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.WriteStringValue(sKeyPath, sValueName, sValue)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_WRITING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If

HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
WriteStringValue = lResult
End Function

Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.DeleteValue(sKeyPath, sValueName)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_DELETING_VALUE_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If

'#doc
'This method seems to return key not found even if it is the value that is not found.
'#end doc
If lResult = ERROR_KEY_NOT_FOUND Then lResult = ERROR_VALUE_NOT_FOUND
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
DeleteValue = lResult
End Function

Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadBinaryValue = Null

On Error Resume Next
ReadBinaryValue = m_oRegistry.ReadBinaryValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0

If m_oError.Number &lt;&gt; 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If

HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function

Private Sub HandleResult(ByVal sHost, ByVal sHive, ByVal sKeyPath, ByVal sValueName, ByVal lResult)
Select Case lResult
Case SUCCESS
Exit Sub
Case ERROR_ACCESS_DENIED
If (SuppressionFlags And SUPPRESS_ACCESS_DENIED) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
WScript.Echo GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_VALUE_NOT_FOUND
If (SuppressionFlags And SUPPRESS_VALUE_NOT_FOUND) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
WScript.Echo GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_KEY_NOT_FOUND
If (SuppressionFlags And SUPPRESS_KEY_NOT_FOUND) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath), Err
Else
WScript.Echo GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath)
End If
Case Else
If (SuppressionFlags And SUPPRESS_ALL) = 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
WScript.Echo GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
End Select
End Sub

Private Function GET_REGISTRY_ACCESS_DENIED_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_ACCESS_DENIED_MESSAGE = "Access denied while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_ACCESS_DENIED_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_ACCESS_DENIED_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function

Private Function GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_VALUE_NOT_FOUND_MESSAGE = "Registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}] not found"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_VALUE_NOT_FOUND_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function

Private Function GET_ERROR_READING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_READING_REGISTRY_MESSAGE = "Error while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_READING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function

Private Function GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const REGISTRY_KEY_NOT_FOUND_MESSAGE = "Registry key [\\{Host}\{Hive}\{RegKey}] not found"
Dim sResult
sResult = Replace(REGISTRY_KEY_NOT_FOUND_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_KEY_NOT_FOUND_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function

Private Function GET_ERROR_READING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_READING_KEY_MESSAGE = "Error while reading registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_READING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function

Private Function GET_ERROR_CREATING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_CREATING_KEY_MESSAGE = "Error while creating registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_CREATING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_CREATING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function

Private Function GET_ERROR_WRITING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_WRITING_REGISTRY_MESSAGE = "Error while writing registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_WRITING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_WRITING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function

Private Function GET_ERROR_DELETING_VALUE_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_DELETING_VALUE_MESSAGE = "Error while deleting registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_DELETING_VALUE_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_DELETING_VALUE_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
End Class ' Safe Registry

'----------------------------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------------------
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class


Function WMIGetObject(ByVal sNamespace)
'
' WMIGetObject :: Returns the WMI object requested.
'
Dim oWMI
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptError "Unable to open WMI Namespace '" &amp; sNamespace &amp; "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
End If

Set WMIGetObject = oWMI

End Function



Function WMIGetInstance(ByVal sNamespace, ByVal sInstance)
'
' WMIGetInstance :: Returns WMI Instance requested.
'
Dim oWMI, oInstance, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptError "Unable to open WMI Namespace '" &amp; sNamespace &amp; "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
End If

On Error Resume Next
Set oInstance = oWMI.InstancesOf(sInstance)
e.Save
On Error Goto 0
If IsEmpty(oInstance) Or e.Number &lt;&gt; 0 Then
ThrowScriptError "The class name '" &amp; sInstance &amp; "' returned no instances. Please check to see if this is a valid WMI class name.", e
End If

'Determine if we queried a valid WMI class - Count will return 0 or empty

On Error Resume Next
nInstanceCount = oInstance.Count
e.Save
On Error Goto 0
If e.Number &lt;&gt; 0 Then
ThrowScriptError "The class name '" &amp; sInstance &amp; "' did not return any valid instances. Please check to see if this is a valid WMI class name.", e
End If

Set WMIGetInstance = oInstance

End Function

Function WMIExecQuery(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQuery :: Executes the WMI query and returns the result set.
'
'
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptError "Unable to open WMI Namespace '" &amp; sNamespace &amp; "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
End If

On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error Goto 0
If IsEmpty(oQuery) Or e.Number &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If

'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error Goto 0
If e.Number &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If

Set WMIExecQuery = oQuery

End Function

Function WMIGetInstanceNoAbort(ByVal sNamespace, ByVal sInstance)
'
' WMIGetInstanceNoAbort :: Returns WMI Instance requested.
'
'
Dim oWMI, oInstance, nInstanceCount

On Error Resume Next
Set oWMI = GetObject(sNamespace)
If Not IsEmpty(oWMI) Then

Set oInstance = oWMI.InstancesOf(sInstance)
If Not IsEmpty(oInstance) And Err.Number = 0 Then

'Determine if we queried a valid WMI class - Count will return 0 or empty
nInstanceCount = oInstance.Count
If Err.Number = 0 Then
Set WMIGetInstanceNoAbort = oInstance
Exit Function
End If
End If
End If
On Error Goto 0

Set WMIGetInstanceNoAbort = Nothing

End Function

Function GetWMIProperty(oWmi, sPropName, nCIMType, ErrAction)
Dim sValue, oWmiProp

If Not IsValidObject(oWmi) Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "Accessing property on invalid WMI object.", Err

If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()

GetWMIProperty = ""
Exit Function
End If

On Error Resume Next
Set oWmiProp = oWmi.Properties_.Item(sPropName)
If Err.Number &lt;&gt; 0 Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" &amp; sPropName &amp; "'.", Err

If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
End If
On Error Goto 0

If IsValidObject(oWmiProp) Then
sValue = oWmiProp.Value

If IsNull(sValue) Then
'
' If value is null, return blank to avoid any issues
'
GetWMIProperty = ""

Else

Select Case (oWmiProp.CIMType)
Case wbemCimtypeString, wbemCimtypeSint16, wbemCimtypeSint32, wbemCimtypeReal32, wbemCimtypeReal64, wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeUint16, wbemCimtypeUint32, wbemCimtypeSint64, wbemCimtypeUint64:
If Not oWmiProp.IsArray Then
GetWMIProperty = Trim(CStr(sValue))
Else
GetWMIProperty = Join(sValue, ", ")
End If
Case wbemCimtypeBoolean:
If sValue = 1 Or UCase(sValue) = "TRUE" Then
GetWMIProperty = "True"
Else
GetWMIProperty = "False"
End If
Case wbemCimtypeDatetime:

Dim sTmpStrDate

'
' First attempt to convert the whole wmi date string
'
sTmpStrDate = Mid(sValue, 5, 2) &amp; "/" &amp; _
Mid(sValue, 7, 2) &amp; "/" &amp; _
Left(sValue, 4) &amp; " " &amp; _
Mid (sValue, 9, 2) &amp; ":" &amp; _
Mid(sValue, 11, 2) &amp; ":" &amp; _
Mid(sValue, 13, 2)
If IsDate(sTmpStrDate) Then
GetWMIProperty = CDate(sTmpStrDate)
Else

'
' Second, attempt just to convert the YYYYMMDD
'
sTmpStrDate = Mid(sValue, 5, 2) &amp; "/" &amp; _
Mid(sValue, 7, 2) &amp; "/" &amp; _
Left(sValue, 4)
If IsDate(sTmpStrDate) Then
GetWMIProperty = CDate(sTmpStrDate)
Else
'
' Nothing works - return passed in string
'
GetWMIProperty = sValue
End If

End If

Case Else:
GetWMIProperty = ""
End Select
End If
Else

If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" &amp; sPropName &amp; "'.", Err

If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()

GetWMIProperty = ""

End If


If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
WScript.Echo " + " &amp; sPropName &amp; " :: '" &amp; GetWMIProperty &amp; "'"

End Function


'----------------------------------------------------------------------------------------------------------------------------------
Function Quit()

WScript.Quit()

End Function

'----------------------------------------------------------------------------------------------------------------------------------
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'

' Dim sErrDescription, sErrNumber
' sErrDescription = oErr.Description
' sErrNumber = oErr.Number

' On Error Resume Next



' Dim oScriptErrorEvent
'
' Set oScriptErrorEvent = ScriptContext.CreateEvent()
' With oScriptErrorEvent
' .EventNumber = 40000
' .EventType = EVENT_TYPE_ERROR
' .Message = sMessage
' .SetEventParameter """Microsoft SQL Server"""
' .SetEventParameter sMessage
' .SetEventParameter sErrDescription
' .SetEventParameter sErrNumber
' End With
' ScriptContext.Submit oScriptErrorEvent
WScript.Echo "ThrowScriptError('" &amp; sMessage &amp; "')"
End Function

'******************************************************************************
Function ThrowScriptError(Byval sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
Wscript.Quit -1
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 = "&lt;LDAP://" &amp; oRootDSE.Get("DnsHostName") &amp; "/&lt;GUID=" &amp; strGUID &amp; "&gt;&gt;;(&amp;(objectCategory=nTDSDSA)(options:1.2.840.113556.1.4.803:=1));adspath,cn;base"
Set rsGCs = oADOConn.Execute(strQuery)
If Err &lt;&gt; 0 Then
CreateEvent EVENT_ID_TOPOLOGY_DISCOVERY_FAILURE, _
EVENT_TYPE_WARNING, _
"The query '" &amp; strQuery &amp; "' failed to execute." &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 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) &lt;&gt; 32 Then
Err.Raise &amp;H80070057, SCRIPT_NAME &amp; "::ReformatGUID", "Invalid Argument"
End If

ReformatGUID = Mid(strOrigGUID, 7, 2) &amp; Mid(strOrigGUID, 5, 2) &amp; Mid(strOrigGUID, 3, 2) &amp; Mid(strOrigGUID, 1, 2)
ReformatGUID = ReformatGUID &amp; "-"
ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 11, 2) &amp; Mid(strOrigGUID, 9, 2)
ReformatGUID = ReformatGUID &amp; "-"
ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 15, 2) &amp; Mid(strOrigGUID, 13, 2)
ReformatGUID = ReformatGUID &amp; "-"
ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 17, 4)
ReformatGUID = ReformatGUID &amp; "-"
ReformatGUID = ReformatGUID &amp; Mid(strOrigGUID, 21, 12)
End Function

Function DNSNameFromDN(sDN)
sDN = Replace(sDN, ".", ",DC=")
sDN = "DC=" &amp; sDN
DNSNameFromDN = sDN
End Function

Function GetDNSName(sPath)
Dim oNTDS, oServer
Set oNTDS = GetObject("LDAP://" &amp; sPath)
Set oServer = GetObject(oNTDS.Parent)
GetDNSName = oServer.Get("dNSHostName")
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 "ADLocalDiscovery.vbs", lngEventID, lngEventType, strMessage
End Sub

'//**************************************************************
'// Discovery For Microsoft Windows Server 2016 Domain Controllers
'// - DC / GC role
'// - SYSVOL - DFSR / NTFRS
'// - DNS
'//**************************************************************
Function CreateDCGCDiscInstance(ByRef iDomainFuncMode, ByRef IsGlobalCatalogServer, ByRef oDiscData, ByRef sTargetComputer, ByRef sCN, ByRef sInfra, ByRef sRID, ByRef sPDC, ByRef sDomain, ByRef strForestSchemaRoot)
Dim iResult, oDfsrInstance, oNtfrsInstance, oDnsInstance, oDomainConInstance
iResult = -1

Select Case iDomainFuncMode
Case 0
Set oNtfrsInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.DomainController.SYSVOL.NTFRS']$")
oNtfrsInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", sTargetComputer
oNtfrsInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/Name$", sCN
oDiscData.AddInstance(oNtfrsInstance)
Case 1
Set oDfsrInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.DomainController.SYSVOL.DFSR']$")
oDfsrInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", sTargetComputer
oDfsrInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/Name$", sCN
oDiscData.AddInstance(oDfsrInstance)
Case 2
Set oDfsrInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.DomainController.SYSVOL.DFSR']$")
oDfsrInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", sTargetComputer
oDfsrInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/Name$", sCN
oDiscData.AddInstance(oDfsrInstance)
Set oNtfrsInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.DomainController.SYSVOL.NTFRS']$")
oNtfrsInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", sTargetComputer
oNtfrsInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/Name$", sCN
oDiscData.AddInstance(oNtfrsInstance)
End Select

If TestDNS() = "True" Then
Set oDnsInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.DomainController.DNS']$")
oDnsInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", sTargetComputer
oDnsInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/Name$", sCN
oDiscData.AddInstance(oDnsInstance)
End If

If IsGlobalCatalogServer = "True" Then
Set oDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.GlobalCatalogServerRole']$")
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/IsGlobalCatalogServer$", IsGlobalCatalogServer
else
Set oDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.DomainControllerRole']$")
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/IsGlobalCatalogServer$", "False"
End If

oDomainConInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", sTargetComputer
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/Name$", sCN
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/InfrastructureMaster$", sInfra
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/RIDMaster$", sRID
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/PDCEmulator$", sPDC
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/DomainNamingMaster$", sDomain
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/SchemaMaster$", strForestSchemaRoot
oDomainConInstance.AddProperty "$MPElement[Name='Microsoft.Windows.Server.2012.R2.AD.DomainControllerRole']/IsRODC$", TestRODC()
oDiscData.AddInstance(oDomainConInstance)
iResult = 0
CreateDCGCDiscInstance = iResult
End Function

'/**************************************************************
' TestRODC
'**************************************************************/
Function TestRODC()
Dim strResult
Dim arrCapaList
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

'/**************************************************************
' Check and see if DNS is installed on the box
'**************************************************************/
Function TestDNS()
dim strResult, oWMI, sQuery, oServices
set oWMI = GetObject("winmgmts:\\.\root\CIMV2")
strResult = "False"

sQuery = "SELECT * from Win32_Service"
set oServices = oWMI.ExecQuery(sQuery)

Dim oService
for each oService in oServices
Select Case LCase(oService.Name)
Case LCase("dns")
strResult = "True"
End Select
Next
TestDNS = strResult
End Function

Call Main()
</Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</ProbeAction>
<ProbeAction ID="WMIProbe" TypeID="Windows!Microsoft.Windows.WmiProbe">
<NameSpace>\\$Target/Property[Type="Windows!Microsoft.Windows.Computer"]/PrincipalName$\root\cimv2</NameSpace>
<Query>select Version from Win32_OperatingSystem</Query>
</ProbeAction>
<ConditionDetection ID="Filter" TypeID="System!System.ExpressionFilter">
<Expression>
<SimpleExpression>
<ValueExpression>
<XPathQuery Type="String">Values/WindowsCurrentVersion</XPathQuery>
</ValueExpression>
<Operator>Equal</Operator>
<ValueExpression>
<Value Type="String">6.3</Value>
</ValueExpression>
</SimpleExpression>
</Expression>
</ConditionDetection>
<ConditionDetection ID="Filter2" TypeID="System!System.ExpressionFilter">
<Expression>
<RegExExpression>
<ValueExpression>
<XPathQuery>Property[@Name='Version']</XPathQuery>
</ValueExpression>
<Operator>MatchesRegularExpression</Operator>
<Pattern>^(6.3.*)$</Pattern>
</RegExExpression>
</Expression>
</ConditionDetection>
</MemberModules>
<Composition>
<Node ID="ScriptProbe">
<Node ID="Filter2">
<Node ID="WMIProbe">
<Node ID="Filter">
<Node ID="RegistryProbe">
<Node ID="Scheduler"/>
</Node>
</Node>
</Node>
</Node>
</Node>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.Discovery.Data</OutputType>
</DataSourceModuleType>