Performs the local discovery of the AD DC Server 2003 Computer Role
This discovery rule discovers a Domain Controller. This is the local discovery.
To disable AD MP monitoring for Domain Controllers override this rule.
| Target | Microsoft.Windows.Server.DC.Computer |
| Enabled | True |
| Frequency | 86400 |
| Remotable | False |
| Discovered Classes and their attribuets: |
|---|
|
| ID | Module Type | TypeId | RunAs |
|---|---|---|---|
| DiscoveryDataSource | DataSource | Microsoft.Windows.Server.AD.CommandExecuterDiscoveryDataSource | Default |
Home
ENU <Discovery ID="Microsoft.Windows.Server.2003.AD.DomainControllerRole.DCDiscovery" Enabled="onEssentialMonitoring" Target="Windows!Microsoft.Windows.Server.DC.Computer" ConfirmDelivery="false" Remotable="false" Priority="Normal">
<Category>Discovery</Category>
<DiscoveryTypes>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.GlobalCatalogServerRole">
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="Name"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="SchemaMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="DomainNamingMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="PDCEmulator"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="RIDMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="InfrastructureMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="IsGlobalCatalogServer"/>
</DiscoveryClass>
<DiscoveryClass TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole">
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="Name"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="SchemaMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="DomainNamingMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="PDCEmulator"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="RIDMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="InfrastructureMaster"/>
<Property TypeID="AD!Microsoft.Windows.Server.AD.DomainControllerRole" PropertyID="IsGlobalCatalogServer"/>
</DiscoveryClass>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.EssentialService.NTFRS">
<Property TypeID="Microsoft.Windows.Server.2003.AD.EssentialService" PropertyID="Name"/>
</DiscoveryClass>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.EssentialService.DFSR">
<Property TypeID="Microsoft.Windows.Server.2003.AD.EssentialService" PropertyID="Name"/>
</DiscoveryClass>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.EssentialService.KDC">
<Property TypeID="Microsoft.Windows.Server.2003.AD.EssentialService" PropertyID="Name"/>
</DiscoveryClass>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.EssentialService.NetLogon">
<Property TypeID="Microsoft.Windows.Server.2003.AD.EssentialService" PropertyID="Name"/>
</DiscoveryClass>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.EssentialService.W32Time">
<Property TypeID="Microsoft.Windows.Server.2003.AD.EssentialService" PropertyID="Name"/>
</DiscoveryClass>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.EssentialService.ISM">
<Property TypeID="Microsoft.Windows.Server.2003.AD.EssentialService" PropertyID="Name"/>
</DiscoveryClass>
<DiscoveryClass TypeID="Microsoft.Windows.Server.2003.AD.EssentialService.SysVol">
<Property TypeID="Microsoft.Windows.Server.2003.AD.EssentialService" PropertyID="Name"/>
</DiscoveryClass>
</DiscoveryTypes>
<DataSource ID="DiscoveryDataSource" TypeID="AD!Microsoft.Windows.Server.AD.CommandExecuterDiscoveryDataSource">
<IntervalSeconds>86400</IntervalSeconds>
<ApplicationName>%windir%\System32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>$file/ADLocalDiscoveryDC.vbs$ 0 $MPElement$ $Target/Id$ $Target/Property[Type="Windows!Microsoft.Windows.Computer"]/PrincipalName$ $Target/Property[Type="Windows!Microsoft.Windows.Computer"]/NetbiosComputerName$</CommandLine>
<TimeoutSeconds>300</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>ADLocalDiscoveryDC.vbs</Name>
<Contents>
'*************************************************************************
' Script Name - AD Local Discovery DC
'
' Purpose - Discovers weather a local server is DC or not
'
' Parameters - Targer fqdn, netbiosname
'
' (c) Copyright 2003, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
' Option Explicit
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 = "AD Essential Services Running"
Const REGKEY_SYSVOL_STATE = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\DFSR\Parameters\SysVols\Migrating SysVols\Local State"
Const ERROR_FILENOTFOUND = &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
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
' Initalize Variables
strForestDNSRoot = ""
strForestSchemaRoot = ""
strDNSName = ""
sPDC = ""
sRID = ""
sInfra = ""
IsGlobalCatalogServer = ""
sCN = TargetFQDNComputer
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
sTargetComputer =TargetFQDNComputer
NetbiosName = TargetNetbiosName
Dim WMISet
' Install the OOMADs Helper Objects
InstallOOMADs()
If Err <> 0 Then
oAPI.LogScriptEvent EventSource, 503, EventSeverityError, "Failed to install or upgrade OOMADS"
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 = 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")
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
Dim iEssentialDiscResult
iEssentialDiscResult = -1
If CreateDCGCDiscInstance(IsGlobalCatalogServer, oDiscData, sTargetComputer, sCN, sInfra, sRID, sPDC, sDomain, strForestSchemaRoot) = 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
'----------------------------------------------------------------------------------------------------------------------------------
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 = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &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://" & 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
'----------------------------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------------------
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 = &H00000001
SUPPRESS_VALUE_NOT_FOUND = &H00000002
SUPPRESS_ACCESS_DENIED = &H00000004
SUPPRESS_ALL = &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 <> 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 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('" & 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
'******************************************************************************
'
' Purpose: Installs the OOMADs Helper Objects
'
' Parameters: None
'
'
Function InstallOOMADs()
Dim state
Dim installer
Dim propertyValues
Dim productGuid
Dim msiPath
Dim wshShell
Dim installDirectory
Dim msiInstallStateDefault
Dim fso
Dim path
Dim database
Dim view
Dim record
Dim installedProductVersion, productVersion
Dim programFiles
Dim wshEnv
Dim scriptAPI
Const EVENT_ID_INSTALL_OOMADS_FAILURE = 10
Const EventSeverityWarning = 2
const EventSource = "AD MP DC Local Discovery"
On Error Resume Next
Set scriptAPI = CreateObject("Mom.ScriptAPI")
'msiInstallStateDefault indicates that the product is installed the current user
msiInstallStateDefault = 5
productGuid = "{AA00C97B-5847-4948-824C-FC4C080B5410}"
set installer = CreateObject("WindowsInstaller.Installer")
state = installer.ProductState(productGuid)
If state = msiInstallStateDefault Then
On Error Resume Next
'check for the oomads.dll file in the correct directory
Set wshShell = CreateObject("WScript.Shell")
Set wshEnv = wshShell.Environment("PROCESS")
programFiles = wshEnv("PROGRAMFILES")
if err.number = 0 Then
path = programFiles & "\Common Files\Active Directory Management Pack Objects\oomads.dll"
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(path)) Then
' If file is present, then log error and exit function
scriptAPI.LogScriptEvent EventSource, EVENT_ID_INSTALL_OOMADS_FAILURE, EventSeverityWarning, "This upgrade is not supported. Can not install OOMADS 64 bit version as there is already a 32 bit version of OOMADS installed"
Exit Function
End If
Err.Clear
End If
End If
' Check whether we need to install AD Helper Objects
Set wshShell = CreateObject("WScript.Shell")
installDirectory = wshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft Operations Manager\3.0\Setup\InstallDirectory")
msiPath = installDirectory & "HelperObjects\OOMADs.msi"
' Check if the msi exists
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(msiPath)) Then
' fetch product guid from MSI
set database = installer.OpenDatabase(msiPath,0)
set view = database.OpenView ("SELECT `Value` FROM `Property` WHERE `Property`.`Property` = 'ProductCode' ")
view.Execute
set record = view.Fetch
productGuid = record.StringData (1)
state = installer.ProductState(productGuid)
' Check whether the product has been installed
If state = msiInstallStateDefault Then
installedProductVersion = installer.ProductInfo(productGuid, "VersionString")
' Get the version of the MSI on disk
set view = database.OpenView ("SELECT `Value` FROM `Property` WHERE `Property`.`Property` = 'ProductVersion' ")
view.Execute
set record = view.Fetch
productVersion = record.StringData (1)
If installedProductVersion = productVersion Then
' Installed product version is the same as the product version on disk - no need to install
Exit Function
End If
End If
' Install OOMADs
propertyValues = "ALLUSERS=1"
installer.UILevel = 2
installer.InstallProduct msiPath, propertyValues
state = installer.ProductState(productGuid)
' Check whether the installation was successful
If state <> msiInstallStateDefault Then
scriptAPI.LogScriptEvent EventSource, EVENT_ID_INSTALL_OOMADS_FAILURE, EventSeverityWarning, "Active Directory Helper Objects installation failed"
End if
Else
scriptAPI.LogScriptEvent EventSource, EVENT_ID_INSTALL_OOMADS_FAILURE, EventSeverityWarning, "Active Directory Helper Objects Installation unsuccessful. MSI was not found at the specified location"
End If
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 (+2)
'//**************************************************************
Function GetEssentialServicesCount(ByVal version)
Dim iResult
Select Case version
Case 2000 iResult = 6
Case 2003 iResult = 6
Case 2008 iResult = 8
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()
'//**************************************************************
'// 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 = "5.2" Then
iResult = 0
End If
End if
FilterADVersion = iResult
End Function
'//**************************************************************
'// Discovery For Windows 2003 DC/GC role
'//**************************************************************
Function CreateDCGCDiscInstance(ByRef IsGlobalCatalogServer, ByRef oDiscData, ByRef sTargetComputer, ByRef sCN, ByRef sInfra, ByRef sRID, ByRef sPDC, ByRef sDomain, ByRef strForestSchemaRoot)
Dim iResult
iResult = -1
If IsGlobalCatalogServer = "True" Then
Set oDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2003.AD.GlobalCatalogServerRole']$")
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/IsGlobalCatalogServer$", IsGlobalCatalogServer
else
Set oDomainConInstance = oDiscData.CreateClassInstance("$MPElement[Name='Microsoft.Windows.Server.2003.AD.DomainControllerRole']$")
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/IsGlobalCatalogServer$", IsGlobalCatalogServer
End If
oDomainConInstance.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", sTargetComputer
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/Name$", sCN
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/InfrastructureMaster$", sInfra
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/RIDMaster$", sRID
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/PDCEmulator$", sPDC
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/DomainNamingMaster$", sDomain
oDomainConInstance.AddProperty "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/SchemaMaster$", strForestSchemaRoot
oDiscData.AddInstance(oDomainConInstance)
iResult = 0
CreateDCGCDiscInstance = iResult
End Function
'//**************************************************************
'// PrepareDiscoveryList For Windows 2003 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(2003)
Dim discList
Dim arrayPropGuid(3)
Dim arrayPropValue(3)
arrayPropGuid(0) = "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$"
arrayPropValue(0) = sTargetComputer
arrayPropGuid(1) = "$MPElement[Name='AD!Microsoft.Windows.Server.AD.DomainControllerRole']/Name$"
arrayPropValue(1) = sCN
arrayPropGuid(2) = "$MPElement[Name='Microsoft.Windows.Server.2003.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='Microsoft.Windows.Server.2003.AD.EssentialService.NTFRS']$", arrayPropGuid, arrayPropValue)
i = i + 1
Case 1
Redim discList(iServiceCount)
arrayPropValue(2) = "DFSR"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='Microsoft.Windows.Server.2003.AD.EssentialService.DFSR']$", 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='Microsoft.Windows.Server.2003.AD.EssentialService.NTFRS']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "DFSR"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='Microsoft.Windows.Server.2003.AD.EssentialService.DFSR']$", arrayPropGuid, arrayPropValue)
i = i + 1
End Select
End If
'/* Enqueue common discovery types */
arrayPropValue(2) = "KDC"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='Microsoft.Windows.Server.2003.AD.EssentialService.KDC']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "NetLogon"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='Microsoft.Windows.Server.2003.AD.EssentialService.NetLogon']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "W32Time"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='Microsoft.Windows.Server.2003.AD.EssentialService.W32Time']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "ISM"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='Microsoft.Windows.Server.2003.AD.EssentialService.ISM']$", arrayPropGuid, arrayPropValue)
i = i + 1
arrayPropValue(2) = "SysVol"
Set discList(i) = CreateInstanceTypeObject("$MPElement[Name='Microsoft.Windows.Server.2003.AD.EssentialService.SysVol']$", arrayPropGuid, arrayPropValue)
PrepareDiscoveryList = discList
End Function
</Contents>
</File>
</Files>
</DataSource>
</Discovery>