<WriteActionModuleType ID="AD_Client_Update_DCs.WriteAction" Accessibility="Internal">
<Configuration>
<xsd:element name="TargetComputerName" type="xsd:string"/>
<xsd:element name="TargetNetbiosDomain" type="xsd:string"/>
<xsd:element name="LogSuccessEvent" type="xsd:boolean"/>
<xsd:element name="SiteDiscoveryMode" type="xsd:string"/>
<xsd:element name="DomainControllers" type="xsd:string"/>
<xsd:element name="Sites" type="xsd:string"/>
<xsd:element name="ManagementGroupName" type="xsd:string"/>
<xsd:element name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="LogSuccessEvent" ParameterType="string" Selector="$Config/LogSuccessEvent$"/>
<OverrideableParameter ID="SiteDiscoveryMode" ParameterType="string" Selector="$Config/SiteDiscoveryMode$"/>
<OverrideableParameter ID="DomainControllers" ParameterType="string" Selector="$Config/DomainControllers$"/>
<OverrideableParameter ID="Sites" ParameterType="string" Selector="$Config/Sites$"/>
<OverrideableParameter ID="TimeoutSeconds" ParameterType="int" Selector="$Config/TimeoutSeconds$"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<WriteAction TypeID="Windows!Microsoft.Windows.ScriptWriteAction" ID="Script">
<ScriptName>AD_Client_Update_DCs.vbs</ScriptName>
<Arguments>$Config/TargetComputerName$ $Config/TargetNetbiosDomain$ $Config/LogSuccessEvent$ $Config/SiteDiscoveryMode$ $Config/ManagementGroupName$ $Config/DomainControllers$ $Config/Sites$</Arguments>
<ScriptBody><Script>
'*************************************************************************
' Script Name - AD Client Update DCs
'
' Purpose - Discovers domain controllers for the other scripts to test
' based on user defined parameters.
'
' Assumptions - Script is run by a timed event
'
' Parameters - SiteDiscoveryMode - 1 - All DCs in Domains (comma delimited)
' 2 - All DCs in specified sites
' 3 - Only DCs in Local Site
' 4 - Only Specified DCs
' - Domains - The sites (comma delimited) to be monitored
' (only relevant when SiteDiscoveryMode is 1)
' If no domains are specified, local domain is used
' - Sites - The sites (comma delimited) to be monitored
' (only relevant when SiteDiscoveryMode is 2)
' - DomainControllers - The domain controllers to be monitored.
' (Used in all modes.)
' - LogSuccessEvent - Logs an event when the script completes.
'
' (c) Copyright 2002, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Dim oParams, TargetFQDNComputer, TargetNetbiosDomain, bLogSuccessEvent, IsTargetAgentless, oAPI
Set oParams = WScript.Arguments
if oParams.Count < 6 then
Wscript.Quit -1
End if
Set oAPI = CreateObject("Mom.ScriptAPI")
Err.Clear
Dim sStateValuePath
sStateValuePath= "HKLM\" & oAPI.GetScriptStateKeyPath(oParams(4))
' Registry Constants
Dim REGISTRY_BASE, REGISTRY_CONFIGURATION, REGISTRY_TESTS
REGISTRY_BASE = sStateValuePath & "\AD Management Pack"
REGISTRY_CONFIGURATION = sStateValuePath & "\AD Management Pack\Configuration"
REGISTRY_TESTS = sStateValuePath & "\AD Management Pack\Tests"
' Script Specific Constants
Const SCRIPT_NAME = "Client Update DCs"
Sub Main()
On Error Resume Next
If Not(IsTargetAgentless) Then
' Initialize the script variables
Dim astrDCs, strDomain, strSites, strDomainControllers, bLogSuccess, dtStart, iMode
strDomain = TargetNetbiosDomain
strComputer = TargetFQDNComputer
dtStart = Now
bLogSuccessEvent = CBool(oParams(2))'LogSuccessEvent
iMode = CLng(oParams(3)) 'SiteDiscoveryMode
'1 - Full Mode - all DCs in Domain
'2 - Specific Site Mode - all DCs in specified sites
'3 - Local Site - all DCs in local site
'4 - Specific Mode - only specified DCs
' Create the OOMADS object for use by the discovery functions
Err.Clear
Set oOOMADS = CreateObject("McActiveDir.ActiveDirectory")
If (0 <> Err.Number) Or (Not(IsObject(oOOMADs))) Then
Dim errorString
errorString = "The script '" & SCRIPT_NAME & "' failed to create object " & _
"'McActiveDir.ActiveDirectory'. This is an unexpected error." & vbCrLf & vbCrLf & _
GetErrorString(Err) & vbCrLf & vbCrLf & _
"The Active Directory Management Pack Objects (OOMADs) components are not installed on the Domain Controller. These components are required for the monitoring scripts to run successfully. See Alert Knowledge for additional details."
CreateEvent EVENT_ID_SCRIPT_FAILURE, EVENT_TYPE_WARNING, errorString
Else
' Read the list of domain controllers and store them in the array
astrDCs = LoadDCsFromConfiguration()
If Err <> 0 Then
ScriptError "loading the Domain Controllers from the configuration file."
End If
' Only use the domain controllers from the script parameters if there weren't any
' loaded from the configuration file
If IsEmpty(astrDCs) Then
strDomainControllers = oParams(5) 'DomainControllers
astrDCs = LoadDCsFromString(strDomainControllers)
If Err <> 0 Then
ScriptError "loading the Domain Controllers from the script parameter " & _
"'DomainControllers'."
End If
End If
' Read the list of sites from the configuration file and put them in
' a string (comma delimited)
strSites = LoadSitesFromConfiguration()
If 0 = Len(strSites) Then
If 2 = iMode Then
' Only use the list of sites from the script parameters if there
' were no sites specified by the configuration file.
strSites = oParams(6)'Sites
If 0 < Len(strSites) Then
Dim iEnd
iEnd = Instr(strSites, ",")
Do While iEnd > 0
RefreshDCsForSite Trim(Left(strSites, iEnd - 1)), astrDCs
If Err <> 0 Then
DiscoveryError "refreshing the DCs for the site '" & _
Trim(Left(strSites, iEnd - 1)) & "'."
End If
strSites = Mid(strSites, iEnd + 1)
iEnd = Instr(strSites, ",")
Loop
RefreshDCsForSite Trim(strSites), astrDCs
If Err <> 0 Then
DiscoveryError "refreshing the DCs for the site '" & _
Trim(strSites) & "'."
End If
End If
End If
If 3 = iMode Then
RefreshDCsForSite GetLocalSite(), astrDCs
If Err <> 0 Then
DiscoveryError "refreshing the DCs for the site '" & _
GetLocalSite() & "'."
End If
End If
Else
iEnd = Instr(strSites, ",")
Do While iEnd > 0
RefreshDCsForSite Trim(Left(strSites, iEnd - 1)), astrDCs
If Err <> 0 Then
DiscoveryError "refreshing the DCs for the site '" & _
Trim(Left(strSites, iEnd - 1)) & "'."
End If
strSites = Mid(strSites, iEnd + 1)
iEnd = Instr(strSites, ",")
Loop
RefreshDCsForSite Trim(strSites), astrDCs
If Err <> 0 Then
DiscoveryError "refreshing the DCs for the site '" & _
Trim(strSites) & "'."
End If
End If
If 1 = iMode And IsEmpty(astrDCs) Then
strDomain = LoadDomainsFromConfiguration()
If Len(strDomain) = 0 Then
strDomain = oParams(6) 'Domains
End If
If Len(strDomain) = 0 Then
strDomain = TargetNetbiosDomain
End If
iEnd = Instr(strDomain, ",")
Do While iEnd > 0
RefreshDCsForDomain Trim(Left(strDomain, iEnd - 1)), astrDCs
If Err <> 0 Then
DiscoveryError "refreshing the DCs for the domain '" & _
Trim(Left(strDomain, iEnd - 1)) & "'."
End If
strDomain = Mid(strDomain, iEnd + 1)
iEnd = Instr(strDomain, ",")
Loop
RefreshDCsForDomain Trim(strDomain), astrDCs
If Err <> 0 Then
DiscoveryError "refreshing the DCs for the domain '" & _
Trim(strDomain) & "'."
End If
End If
' Save the new list of DCs
astrDCs = SaveDCsToFile(astrDCs)
If Err <> 0 Then
ScriptError "writing the DCs to file."
ElseIf bLogSuccessEvent Then
Dim strDCs
If IsArray(astrDCs) Then
Dim iIndex
For iIndex = 0 to UBound(astrDCs)
If Instr(astrDCs(iIndex), "\") <> 0 Then
strDCs = strDCs & Mid(astrDCs(iIndex), InstrRev(astrDCs(iIndex), "\") + 1) & vbCrLf
Else
strDCs = strDCs & astrDCs(iIndex) & vbCrLf
End If
Next
End If
CreateEvent EVENT_ID_SUCCESS, EVENT_TYPE_INFORMATION, "The script '" & _
SCRIPT_NAME & "' completed in " & DateDiff("s", dtStart, Now) & _
" seconds." & vbCrLf & vbCrLf & _
"The DCs being monitored are:" & vbCrLf & strDCs
End If
End If
Else
CreateEvent EVENT_ID_AGENTLESS, EVENT_TYPE_ERROR, "The AD Management Pack does not support the agentless management mode." & vbCrLf & _
"The script '" & SCRIPT_NAME & "' will not execute." & vbCrLf & _
"To prevent this alert being generated again, either change the monitoring " & _
"mode of the computer '" & TargetFQDNComputer & "' to agent-managed " & _
"or disable the rule that generated this alert."
End If
'Else
'CreateEvent EVENT_ID_EVENT_RULE_ONLY, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' can only be executed by an event rule."
'End If
End Sub
'******************************************************************************
Sub Insert(ByRef astrings, strNew)
'
' Purpose: To insert a string into an array.
'
' Parameters: astrings - the array to insert into
' strNew - the string to insert
'
' Returns: nothing
'
' Remarks: This function can throw errors. The caller must catch these errors.
'
If IsArray(astrings) Then
Dim iSize
iSize = UBound(astrings)
Redim Preserve astrings(iSize + 1)
astrings(iSize) = strNew
Else
astrings = Array(strNew, "")
End If
End Sub
'******************************************************************************
Function SaveDCsToFile(astrDCs)
'
' Purpose: To save an array of DC names to a file
'
' Parameters: astrDCs - the array of names to save to the file
'
' Returns: Nothing
'
Dim oFSO, oTempFolder, oFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTempFolder = oFSO.GetSpecialFolder(2) ' Temp Folder
Set oFile = oFSO.CreateTextFile(oTempFolder.Path & "\MonitoredDCs.txt", True, True)
' Only write the DCs out if there are any. Otherwise just close the file.
If IsArray(astrDCs) Then
Dim iIndex, astrStoredDCs
For iIndex = 0 to UBound(astrDCs)
' Get the flat name for the DCs and their domains and store that.
' MOM uses the flatnames internally and we don't want to have to
' try to retrieve them when we are performing the tests
Dim strFlatName, strDomainName
strFlatName = ""
strDomainName = ""
If Len(astrDCs(iIndex)) > 0 Then
On Error Resume Next
strFlatName = oOOMADS.GetFlatComputerName(astrDCs(iIndex))
If 0 = Err Then
strDomainName = oOOMADS.GetFlatDomainForDC(strFlatName)
If 0 = Err Then
On Error Goto 0
Dim strLine
strLine = Trim(strDomainName) & "\" & Trim(strFlatName) & "\" & astrDCs(iIndex)
If Not ArrayContains(astrStoredDCs, strLine) Then
oFile.WriteLine strLine
Insert astrStoredDCs, strLine
End If
Else
DiscoveryError "obtaining the flat domain name for the DC '" & astrDCs(iIndex) & "'"
End If
Else
DiscoveryError "obtaining the flat name for the DC '" & astrDCs(iIndex) & "'"
End If
On Error Goto 0
End If
Next
End If
oFile.Close
SaveDCsToFile = astrStoredDCs
End Function
'******************************************************************************
Sub RefreshDCsForSite(strSite, astrDCs)
'
' Purpose: To retrieve a list of the DCs for a given site.
'
' Parameters: strSite - The site being queried
' astrDCs - An array to populate with the DCs
'
' Returns: Nothing
'
Dim lError, strErrorDescription, strErrorSource
On Error Resume Next
Dim avarDCs
avarDCs = oOOMADS.GetDCsForSite(strSite)
If 0 = Err Then
Dim iIndex
For iIndex = 0 to UBound(avarDCs)
If Len(avarDCs(iIndex)) > 0 Then
Insert astrDCs, avarDCs(iIndex)
End If
Next
Else
lError = Err.number
strErrorDescription = err.Description
strErrorSource = SCRIPT_NAME & "::RefreshDCsForSite"
If Len(strErrorDescription) = 0 Then
strErrorDescription = "oOOMADS.GetDCsForSite returned an error"
End If
On Error Goto 0
Err.Raise lError, strErrorSource, strErrorDescription
End If
End Sub
'******************************************************************************
Function GetLocalSite()
'
' Purpose: To retrieve the site for this computer.
'
' Returns: String, the site (or an empty string if it cannot be determined)
'
Dim oADSysInfo
Set oADSysInfo = CreateObject("ADSystemInfo")
GetLocalSite = oADSysInfo.SiteName
End Function
'******************************************************************************
Function LoadDCsFromConfiguration()
'
' Purpose: To load the list of DCs from the configuration file and to store
' them in an array
'
' Parameters: none
'
' Returns: An array with DCs in it (or Empty if there are no DCs specified)
'
On Error Resume Next
' Open the registry and look for the Domain Controllers key
Dim oReg
Set oReg = CreateObject("WScript.Shell")
If 0 <> Err Then
ScriptError "create the 'WScript.Shell' object."
Else
' Read the DomainControllers entry in the registry
Dim strKey, strValue
strKey = REGISTRY_CONFIGURATION & "\Domain Controllers"
strValue = oReg.RegRead(strKey)
If 0 < Len(strValue) Then
LoadDCsFromConfiguration = LoadDCsFromString(strValue)
Else
If Err = &H80040004 Or _
Err = &H80070002 Or _
Err = &H80070003 Or _
Err = 0 Then
' There was either no data for the key, or the key was not there. Either way
' we should just return Empty
LoadDCsFromConfiguration = Empty
Err.Clear
End If
End If
End If
End Function
'******************************************************************************
Function LoadSitesFromConfiguration()
'
' Purpose: To load the list of Sites from the configuration file and to store
' them in a comma delimited string
'
' Parameters: none
'
' Returns: String - the comma delimited string of sites
'
On Error Resume Next
' Open the registry and look for the Domain Controllers key
Dim oReg
Set oReg = CreateObject("WScript.Shell")
If 0 <> Err Then
ScriptError "create the 'WScript.Shell' object."
Else
' Read the DomainControllers entry in the registry
Dim strKey, strValue
strKey = REGISTRY_CONFIGURATION & "\Sites"
strValue = oReg.RegRead(strKey)
If 0 < Len(strValue) Then
LoadSitesFromConfiguration = strValue
Else
If &H80070002 = Err Or 0 = Err Then
' There was either no data for the key, or the key was not there. Either way
' we should just return Empty
LoadSitesFromConfiguration = Empty
Err.Clear
End If
End If
End If
End Function
'******************************************************************************
Function LoadDomainsFromConfiguration()
'
' Purpose: To load the list of Domains from the configuration file and to store
' them in a comma delimited string
'
' Parameters: none
'
' Returns: String - the comma delimited string of sites
'
On Error Resume Next
' Open the registry and look for the Domains key
Dim oReg
Set oReg = CreateObject("WScript.Shell")
If 0 <> Err Then
ScriptError "create the 'WScript.Shell' object."
Else
' Read the DomainControllers entry in the registry
Dim strKey, strValue
strKey = REGISTRY_CONFIGURATION & "\Domains"
strValue = oReg.RegRead(strKey)
If 0 < Len(strValue) Then
LoadDomainsFromConfiguration = strValue
Else
If &H80070002 = Err Or 0 = Err Then
' There was either no data for the key, or the key was not there. Either way
' we should just return Empty
LoadDomainsFromConfiguration = ""
Err.Clear
End If
End If
End If
End Function
'******************************************************************************
Function LoadDCsFromString(strDomainControllers)
'
' Purpose: To load the list of DCs from the given string and to store
' them in an array
'
' Parameters: strDomainControllers - a comma delimited list of domain controller
' names
'
' Returns: An array with DCs in it (or Empty if there are no DCs specified)
'
Dim astrDCs
' Refresh the list of DCs
If 0 < Len(strDomainControllers) Then
Dim iEnd
iEnd = Instr(strDomainControllers, ",")
Do While iEnd > 0
Insert astrDCs, Trim(Left(strDomainControllers, iEnd - 1))
strDomainControllers = Mid(strDomainControllers, iEnd + 1)
iEnd = Instr(strDomainControllers, ",")
Loop
Insert astrDCs, Trim(strDomainControllers)
End If
LoadDCsFromString = astrDCs
End Function
'******************************************************************************
Sub CreateEvent(lEventID, lEventType, strMessage)
'
' Purpose: To generate a MOM event
'
' Arguments: lEventID, the event code
' lEventType, the severity of the event
' strMessage, the message to include in the event
'
On Error Resume Next
oAPI.LogScriptEvent "Client Update DCs" ,lEventID, lEventType, strMessage
End Sub
'******************************************************************************
Sub ScriptError(strContext)
'
' Purpose: To generate an alert for the current error and then throw the
' exception so it can be caught at a higher level.
'
' Arguments: strContext - the current context, this is added to the message
' that is alerted to the user
'
' Returns: nothing
'
' Remarks: Always throws an error
'
Dim strError
strError = "The script '" & SCRIPT_NAME & "' encountered an error while " & strContext & _
GetErrorString(Err)
CreateEvent EVENT_ID_SCRIPT_FAILURE, EVENT_TYPE_WARNING, strError
End Sub
'******************************************************************************
Sub DiscoveryError(strContext)
'
' Purpose: To generate an alert for the current error and then throw the
' exception so it can be caught at a higher level.
'
' Arguments: strContext - the current context, this is added to the message
' that is alerted to the user
'
' Returns: nothing
'
' Remarks: Always throws an error
'
Dim strError
strError = "The script '" & SCRIPT_NAME & "' encountered an error while " & strContext & vbCrLf & _
"The Domain Controllers affected will not be monitored by the client pack " & _
"until discovery succeeds. Discovery of other domain controllers will not " & _
"be affected." & _
GetErrorString(Err)
CreateEvent EVENT_ID_DISCOVERY_ERROR, EVENT_TYPE_ERROR, strError
End Sub
'******************************************************************************
Function GetErrorString(oErr)
'
' Purpose: Attempts to find the description for an error if an error with
' no description is passed in.
'
' Parameters: oErr, the error object
'
' Return: String, the description for the error. (Includes the error code.)
'
Dim lErr, strErr, strSource
lErr = oErr
strErr = oErr.Description
strSource = oErr.Source
On Error Resume Next
If 0 >= Len(strErr) Then
' If we don't have an error description, then check to see if the error
' is a 0x8007xxxx error. If it is, then look it up.
Const ErrorMask = &HFFFF0000
Const HiWord8007 = &H80070000
Const LoWordMask = 65535 ' This is equivalent to 0x0000FFFF
If (lErr And ErrorMask) = HiWord8007 Then
' Attempt to use 'net helpmsg' to get a description for the error.
Dim oShell
Set oShell = CreateObject("WScript.Shell")
If Err = 0 Then
Dim oExec
Set oExec = oShell.Exec("net helpmsg " & (lErr And LoWordMask))
Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i < 5)
strErr = strMessage
End If
Else
Select Case lErr
Case &H80041003
strErr = "WMI Provider Returned : Access Denied"
End Select
End If
End If
If 0 >= Len(strErr) Then
GetErrorString = vbCrLf & "The error code returned was (0x" & Hex(lErr) & ")"
Else
GetErrorString = vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End If
If 0 < Len(strSource) Then
GetErrorString = GetErrorString & vbCrLf & "Source : " & strSource
End If
End Function
'******************************************************************************
Sub RefreshDCsForDomain(strDomain, astrDCs)
'
' Purpose: To retrieve a list of the DCs for the given domain.
'
' Parameters: strDomain - The domain(s) to search in.
' Multiple domains should be separated by a comma
' astrDCs - An array to populate with the DCs
'
' Returns: Nothing
'
Dim lError, strErrorDescription, strErrorSource
On Error Resume Next
Dim iCurrentPos
iCurrentPos = 1
If 0 < Len(strDomain) Then
Do
Dim strCurrentDomain, iDomainNameLength
iDomainNameLength = Instr(iCurrentPos, strDomain, ",")
If 0 = iDomainNameLength Then
strCurrentDomain = Trim(Mid(strDomain, iCurrentPos))
Else
strCurrentDomain = Trim(Mid(strDomain, iCurrentPos, iDomainNameLength - iCurrentPos))
End If
iCurrentPos = iDomainNameLength + 1
Dim avarDCs
avarDCs = oOOMADS.GetDCsForDomain(strDomain)
If 0 = Err Then
Dim iIndex
For iIndex = 0 to UBound(avarDCs)
If Len(avarDCs(iIndex)) > 0 Then
Insert astrDCs, avarDCs(iIndex)
End If
Next
Else
lError = Err.number
strErrorDescription = err.Description
strErrorSource = SCRIPT_NAME & "::RefreshDCsForDomain"
If Len(strErrorDescription) = 0 Then
strErrorDescription = "oOOMADS.GetDCsForSite returned an error"
End If
On Error Goto 0
Err.Raise lError, strErrorSource, strErrorDescription
End If
Loop Until iDomainNameLength = 0
End If
End Sub
'******************************************************************************
Function ArrayContains(astrArray, strData)
'
' Purpose: Determines whether a string is already stored in an array.
'
' Parameters: astrArray - The array to check
' strData - The string to look for
'
' Returns: True if the array does contain the string, False otherwise
'
ArrayContains = False
If IsArray(astrArray) Then
Dim iIndex
For iIndex = 0 To UBound(astrArray)
If astrArray(iIndex) = strData Then
ArrayContains = True
End If
Next
End If
End Function
Home
ENU 
Show References: