'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 < 5 Then
Wscript.Quit -1
End If
SourceType = oArgs(0)
SourceID = oArgs(1)
ManagedEntityId = oArgs(2)
TargetFQDNComputer = oArgs(3)
TargetNetbiosName = oArgs(4)
Discoveryflag = false
Set oAPI = CreateObject("Mom.ScriptAPI")
If Err <> 0 Then
Wscript.Quit -1
End if
oAPI.LogScriptEvent EventSource, 501, EventSeverityInfo, "Local Discovery Started, SourceID: " & SourceID & " ManagedEntityId: " & ManagedEntityId
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
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, sConfigNC, sDNC
sDNC = oRootDSE.Get("defaultNamingContext")
sConfigNC = oRootDSE.Get("configurationNamingContext")
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," & sConfigNC)
sDomain = GetDNSName(oDomain.Get("fSMORoleOwner"))
End if
Err.Clear
Set oADOConn = CreateObject("ADODB.Connection")
Dim strQuery
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 & ">;(&(objectCategory=computer)(cn="& NetbiosName &"));cn,distinguishedName,dNSHostName,serverReferenceBL;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")
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) <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_ERROR, "Active Directory DC / GC discovery failed! The error returned was " & 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 <> 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
'----------------------------------------------------------------------------------------------------------------------------------
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
Public Sub Connect(ByVal sHostName)
Set m_oReg = GetObject("winmgmts://" & sHostName & "/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
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 <> 0 Then
ThrowScriptErrorNoAbort "Failed to connect to the WMI registry provider on " & 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 <> 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 <> 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 <> 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 <> 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 <> 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 <> 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 <> 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 <> 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 '" & sNamespace & "'. 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 '" & sNamespace & "'. 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 <> 0 Then
ThrowScriptError "The class name '" & sInstance & "' 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 <> 0 Then
ThrowScriptError "The class name '" & sInstance & "' 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 '" & sNamespace & "'. 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 <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' 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 <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' 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 <> 0 Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", 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) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4) & " " & _
Mid (sValue, 9, 2) & ":" & _
Mid(sValue, 11, 2) & ":" & _
Mid(sValue, 13, 2)
If IsDate(sTmpStrDate) Then
GetWMIProperty = CDate(sTmpStrDate)
Else
'
' Second, attempt just to convert the YYYYMMDD
'
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
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: '" & sPropName & "'.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
GetWMIProperty = ""
End If
If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
WScript.Echo " + " & sPropName & " :: '" & GetWMIProperty & "'"
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 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('" & sMessage & "')"
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 = "<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)
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
'******************************************************************************
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.2016.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.2016.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.2016.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.2016.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.2016.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.2016.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.2016.AD.DomainControllerRole']$")
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.Library.DomainControllerRole']/IsGlobalCatalogServer$", "False"
End If
'/**************************************************************
' 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
Home
ENU 
Show References: