<DataSourceModuleType ID="AD_Client_PDC_Response.DataSource" Accessibility="Internal">
<Configuration>
<xsd:element name="IntervalSeconds" type="xsd:int"/>
<xsd:element name="TargetComputerName" type="xsd:string"/>
<xsd:element name="LogSuccessEvent" type="xsd:boolean"/>
<xsd:element name="FailureThreshold" type="xsd:int"/>
<xsd:element name="SuccessCount" type="xsd:int"/>
<xsd:element name="ManagementGroupName" type="xsd:string"/>
<xsd:element name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" ParameterType="int" Selector="$Config/IntervalSeconds$"/>
<OverrideableParameter ID="LogSuccessEvent" ParameterType="string" Selector="$Config/LogSuccessEvent$"/>
<OverrideableParameter ID="FailureThreshold" ParameterType="int" Selector="$Config/FailureThreshold$"/>
<OverrideableParameter ID="SuccessCount" ParameterType="int" Selector="$Config/SuccessCount$"/>
<OverrideableParameter ID="TimeoutSeconds" ParameterType="int" Selector="$Config/TimeoutSeconds$"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="System!System.CommandExecuterPropertyBagSource">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<ApplicationName>%windir%\system32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>//nologo $file/AD_Client_PDC_Response.vbs$ $Config/TargetComputerName$ $Config/LogSuccessEvent$ $Config/FailureThreshold$ $Config/SuccessCount$ $Config/ManagementGroupName$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>AD_Client_PDC_Response.vbs</Name>
<Contents><Script>
'*************************************************************************
' Script Name - Client PDC Response
'
' Purpose - Determines if the PDC is available and
' monitors its response time
'
' Assumptions - Script is run by a timed event
'
' Parameters - SuccessCount - This parameter is used to
' determine how many executions of this script will
' pass after a successful test before another test
' is carried out.
' - FailureThreshold - This parameter is the number of
' consecutive failures that must occur before an event is
' generated. (This is for each Op Master individually)
' - LogSuccessEvent - Logs an event when the script completes.
'
' (c) Copyright 2002, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
' The maximum number of times to retry the ping or bind if a failure occurs.
Const MAX_REPEAT_COUNT = 2
Dim strMaster, strMessage, strComputer, lFailLimit, lSuccessCount, bLogSuccess, dtStart, oParams
Set oParams = WScript.Arguments
if oParams.Count < 5 Then
Wscript.quit -1
End if
' Accessed via many parts of the script
Dim IsTargetAgentless,TargetFQDNComputer, objAD, oReg, oAPI, oBag
IsTargetAgentless = false
oReg = Null
Set oAPI = CreateObject("Mom.ScriptAPI")
Err.Clear
Dim sStateValuePath
sStateValuePath= "HKLM\" & oAPI.GetScriptStateKeyPath(oParams(4))
' Registry Path to share data across scripts
Dim REG_Key
REG_Key = sStateValuePath & "\AD Management Pack\Client PDC Response"
If Not(IsTargetAgentless) Then
dtStart = Now
TargetFQDNComputer = oParams(0)
bLogSuccess = CBool(oParams(1))'LogSuccessEvent
strComputer = TargetFQDNComputer
Dim strInvalidParams
Err.Clear
lFailLimit = CLng(oParams(2)) 'FailureThreshold
If (1 > lFailLimit) Or (20 < lFailLimit) Then
strInvalidParams = strInvalidParams & "FailureThreshold must be between 1 and 20." & vbCrLf & _
"The current value of FailureThreshold is " & _
lFailLimit & "." & vbCrLf & _
"FailureThreshold will be set to 3 for this execution " & _
"of this script." & vbCrLf & vbCrLf
lFailLimit = 3
End If
Err.Clear
lSuccessCount = CLng(oParams(3))'SuccessCount
If (1 > lSuccessCount) Or (48 < lSuccessCount) Then
strInvalidParams = strInvalidParams & "SuccessCount must be between 1 and 48." & vbCrLf & _
"The current value of SuccessCount is " & _
lSuccessCount & "." & vbCrLf & _
"SuccessCount will be set to 3 for this execution " & _
"of this script." & vbCrLf & vbCrLf
lSuccessCount = 3
End If
If 0 < Len(strInvalidParams) Then
CreateEvent EVENT_ID_INVALID_PARAMETER, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & _
"' detected one or more invalid parameters." & _
vbCrLf & vbCrLf & strInvalidParams & vbCrLf & vbCrLf & _
"To correct the error, find the rule 'Script - " & _
SCRIPT_NAME & "' and from the response tab of it's " & _
"properties, edit the script and modify the parameter in question."
End If
Set objAD = CreateObject("McActiveDir.ActiveDirectory")
If (0 <> Err.Number) Or (Not(IsObject(objAD))) 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."
If Trim(strMaster) <> "" Then
PingAndBind objAD, _
strMaster, _
1, _
"PDC Op Master", _
"PDC Ping Time", _
"PDC Bind Time", _
EVENT_BASE_PDC_MASTER
Else
strMessage = "The script '" & SCRIPT_NAME & "' could not determine the PDC Op Master." & _
GetErrorString(Err)
CreateEvent EVENT_BASE_PDC_MASTER, EVENT_TYPE_ERROR, strMessage & GetErrorString(Err)
bLogSuccess = False
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "BAD"
oBag.AddValue "EventID", "" & EVENT_BASE_PDC_MASTER
oAPI.AddItem oBag
End If
End If
If bLogSuccess Then
CreateEvent EVENT_ID_SUCCESS, EVENT_TYPE_INFORMATION, "The script '" & SCRIPT_NAME & "' completed in " & _
DateDiff("s", dtStart, Now) & " seconds."
End If
Set objAD = Nothing
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
'strMessage = "The script '" & SCRIPT_NAME & "' can only be executed by an event rule."
'CreateEvent EVENT_ID_EVENT_RULE_ONLY, EVENT_TYPE_WARNING, strMessage
'End If
Call oAPI.ReturnItems()
End Sub
'******************************************************************************
' Name: CreateEvent
'
' 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
'
Sub CreateEvent(lngEventID, lngEventType, strMessage)
oAPI.LogScriptEvent "Client PDC Response", lngEventID, lngEventType, strMessage
End Sub
'******************************************************************************
' Name: CreateRemoteEvent
'
' Purpose: Creates a MOM event
'
' Parameters: strComputer, the computer to raise the event on
' lngEventID, the ID for the event
' lngEventType, the severity for the event. See constants at head of file
' strMessage, the message for the event
'
Sub CreateRemoteEvent(strComputer, lngEventID, lngEventType, strMessage)
Dim objNewEvent
End Sub
'******************************************************************************
' Name: PingAndBind
'
' Purpose: To determine what level of contact can be established with a specified machine
'
' Parameters: objAD, the ActiveDir.ActiveDirectory object
' strDC, the name of the target machine
' lSuccessWait, the number of iterations to wait after a successful bind
' strDCDesc, the description of the machine (used in event strings)
' strPingPerfDataName, the name of the 'ping' performance counter
' strBindPerfDataName, the name of the 'bind' performance counter
' lEvtID, the base event ID for the MOM events
'
Sub PingAndBind(objAD, strDC, lSuccessWait, strDCDesc, strPingPerfDataName, strBindPerfDataName, lEvtID)
On Error Resume Next
Dim strMaster
strMaster = LCase(objAD.GetFlatComputerName(strDC))
If Err <> 0 Then
strMaster = strDC
End If
' Check to see if we either failed last time, or our success count >= lSuccessWait
Dim lSuccessCount , tlSuccessCount
tlSuccessCount = GetData("SuccessCount" & lEvtID)
if tlSuccessCount = "" Then
lSuccessCount = 0
Else
lSuccessCount = CLng (tlSuccessCount)
End if
If (lSuccessCount > 0) And (lSuccessCount < lSuccessWait) Then
SetData "SuccessCount" & lEvtID, lSuccessCount + 1
Else
' Reset the success count. If we encounter a failure we'll overwrite it.
SetData "SuccessCount" & lEvtID, 1
Dim strIPAddress, bBindSuccess, bPingSuccess, bDNSSuccess, lAttemptCount
strIPAddress = objAD.GetIPAddress(strDC)
bBindSuccess = False
bPingSuccess = False
bDNSSuccess = False
If Len(strIPAddress) > 0 Then
bDNSSuccess = True
Dim lngPingTime
lngPingTime = 0
lAttemptCount = 0
' If the ping or bind fails then retry it up to MAX_REPEAT_COUNT times.
' This is to accomodate any transient network conditions that may exist.
Do
lngPingTime = objAD.Ping(strIPAddress)
If 0 > lngPingTime Then
' Wait a bit before trying again.
objAD.Sleep 100
End If
lAttemptCount = lAttemptCount + 1
Loop While (0 > lngPingTime) And (lAttemptCount < MAX_REPEAT_COUNT)
If 0 <= lngPingTime Then
lAttemptCount = 0
bPingSuccess = True
' Create Performance Data in seconds rather than milliseconds
Dim oMaster
Do
Set oMaster = objAD.BindObject("LDAP://" & strDC & "/RootDSE")
If Err = 0 And IsObject(oMaster) Then
bBindSuccess = True
Set oMaster = nothing
' Create Performance Data in seconds rather than milliseconds
Set oBag = oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusCounter","PDC Bind Perf" )
Call oBag.AddValue("StatusInstance", strDC )
Call oBag.AddValue("StatusValue", "" & (objAD.BindLast / 1000) )
oAPI.AddItem oBag
Else
' Wait a bit before trying again.
objAD.Sleep 100
End If
lAttemptCount = lAttemptCount + 1
Loop While (bBindSuccess = False) And (lAttemptCount < MAX_REPEAT_COUNT)
End If
End If
If False = bBindSuccess Then
Dim strMessage
If True = bPingSuccess Then
strMessage = "Failed to bind to " & strDCDesc & " '" & strMaster & "' (" & strIPAddress & ")."
HandleScriptFailure strMaster, lEvtID, strMessage
Else
Dim oWMI, oX
If True = bDNSSuccess Then
' Can we ping the default gateway?
Dim bDefaultGatewayContactable
Dim strDefaultGateway
Set oWMI = GetObject("winmgmts:\\" & strDC).ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration")
If IsEmpty(oWMI) Then
strMessage = strMessage & "There are no DNS servers configured for this machine."
Else
If IsObject(oWMI) Then
For Each oX in oWMI
If Not(IsNull(oX)) Then
If Not(IsNull(oX.DefaultIPGateway)) Then
Dim lDefaultGatewayPingTime
If IsArray(oX.DefaultIPGateway) Then
' Determine if the default gateway can be pinged.
Dim iIndex
For iIndex = 0 To GetUBound(oX.DefaultIPGateway)
lDefaultGatewayPingTime = objAD.Ping(oX.DefaultIPGateway(iIndex))
strDefaultGateway = oX.DefaultIPGateway(iIndex)
If (lDefault > 0) Then
bDefaultGatewayContactable = True
strDefaultGateway = oX.DefaultIPGateway(iIndex)
End If
Next
Else
' Determine if the default gateway can be pinged.
lDefaultGatewayPingTime = objAD.Ping(oX.DefaultIPGateway)
strDefaultGateway = oX.DefaultIPGateway
If (lDefault > 0) Then
bDefaultGatewayContactable = True
End If
End If
End If
End If
Next
End If
End If
strMessage = "Failed to ping " & strDCDesc & " '" & strMaster & _
"' (" & strIPAddress & ")." & vbCrLf
If bDefaultGatewayContactable Then
strMessage = strMessage & "The default gateway (" & strDefaultGateway & ") " & _
"is pingable."
Else
strMessage = strMessage & "The default gateway (" & strDefaultGateway & ") " & _
"is not pingable."
End If
HandleScriptFailure strMaster, lEvtID, strMessage
Else
strMessage = "Failed to resolve IP address for " & strDCDesc & " '" & strMaster & "'." & vbCrLf
' Work out what the configured DNS servers are:
Set oWMI = GetObject("winmgmts:\\" & strDC).ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration")
If IsEmpty(oWMI) Then
strMessage = strMessage & "There are no DNS servers configured for this machine."
Else
Dim strDNSServers
' Add the configured DNS Servers to the message
strDNSServers = strDNSServers & "The configured DNS servers for this machine are:" & vbCrLf
Dim strDNS
If IsObject(oWMI) Then
For Each oX in oWMI
If Not(IsNull(oX)) Then
If Not(IsNull(oX.DNSServerSearchOrder)) Then
For Each strDNS in oX.DNSServerSearchOrder
If Len(strDNS) > 0 Then
strDNSServers = strDNSServers & strDNS & vbCrLf
End If
Next
End If
End If
Next
End If
strMessage = strMessage & vbCrLf & vbCrLf & strDNSServers
End If
HandleScriptFailure strMaster, lEvtID, strMessage
End If
End If
Else
ResetConsecutiveErrCnt strMaster, lEvtID
End If
End If
End Sub
'******************************************************************************
' Name: GetErrorString
'
' 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.)
'
Function GetErrorString(oErr)
Dim lErr, strErr
lErr = oErr
strErr = oErr.Description
On Error Resume Next
If 0 >= Len(strErr) Then
' If we don't have an error description, then check to see if the error
' is a 0x8007xxxx error. If it is, then look it up.
Const ErrorMask = &HFFFF0000
Const HiWord8007 = &H80070000
Const LoWordMask = 65535 ' This is equivalent to 0x0000FFFF
If (lErr And ErrorMask) = HiWord8007 Then
' Attempt to use 'net helpmsg' to get a description for the error.
Dim oShell
Set oShell = CreateObject("WScript.Shell")
If Err = 0 Then
Dim oExec
Set oExec = oShell.Exec("net helpmsg " & (lErr And LoWordMask))
Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i < 5)
strErr = strMessage
End If
End If
End If
GetErrorString = "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
' Name: HandleScriptFailure
'
' Purpose: Handles a script failure. This checks to see if the number of
' failures has exceeded the threshold and if so generates an
' event. Also updates the daily count.
'
' Parameters: strComputer, the computer to raise the event on
' lEvtID, an event ID for the error type being dealt with.
' Used to differentiate failures for each Op Master.
' The lEvtID should be unique for each Op Master, but should
' be the same for all calls from the same Op Master.
' strFailure, the description of the failure.
'
Sub HandleScriptFailure(strComputer, lEvtID, strFailure)
On Error Resume Next
Dim lCurrentErrCnt, tlCurrentErrCnt
tlCurrentErrCnt = GetData("ErrCnt" & lEvtID)
if tlCurrentErrCnt = "" Then
lCurrentErrCnt = 1
else
lCurrentErrCnt = Clng(tlCurrentErrCnt) + 1
end if
Dim strHistory
strHistory = CStr(GetData("ErrHistory" & lEvtID)) & strFailure & vbCrLf
If lCurrentErrCnt <= lFailLimit Then
SetData "ErrHistory" & lEvtID, strHistory
End If
If lCurrentErrCnt = lFailLimit Then
' Generate an event detailing the errors that occurred.
Dim strMessage
strMessage = GetData("ErrDesc" & lEvtID)
strMessage = "While running '" & SCRIPT_NAME & "' " & lFailLimit & _
" consecutive errors were encountered." & vbCrLf & _
"A message will be generated when the script succeeds. " & _
"Look for a 'success' event from '" & SCRIPT_NAME & _
"' with ID = " & lEvtID & "." & vbCrLf & vbCrLf & _
"The events that triggered this alert were:" & vbCrLf & vbCrLf & _
strHistory
CreateEvent lEvtID, EVENT_TYPE_WARNING, strMessage
End If
CreateRemoteEvent strComputer, lEvtID + 1, EVENT_TYPE_WARNING, strFailure
' Increment the counters
Dim temp
SetData "ErrCnt" & lEvtID, lCurrentErrCnt
' Set the SuccessCount to 0 so that we'll execute the test again
' the next time the script runs
SetData "SuccessCount" & lEvtID, 0
End Sub
'******************************************************************************
' Name: ResetConsecutiveErrCnt
'
' Purpose: Resets the consecutive error count. Called when the script
' completes successfully.
'
' Parameters: strComputer, the computer to raise the event on
' lEvtID, an event ID for the error type being dealt with.
' Used to segregate failures for each Op Master.
'
Sub ResetConsecutiveErrCnt(strComputer, lEvtID)
On Error Resume Next
Dim lConsecutiveErrors, tlConsecutiveErrors
tlConsecutiveErrors = GetData("ErrCnt" & lEvtID)
if tlConsecutiveErrors = "" Then
lConsecutiveErrors = 0
else
lConsecutiveErrors = CLng(tlConsecutiveErrors)
end if
If lConsecutiveErrors >= lFailLimit Then
' We have succeeded after a number of consecutive failures. Create a
' success event.
Dim strErrDesc
strErrDesc = GetData("ErrDesc" & lEvtID)
CreateEvent lEvtID, EVENT_TYPE_SUCCESS, "The script '" & _
SCRIPT_NAME & "' has succeeded following " & _
lConsecutiveErrors & " consecutive failures." & vbCrLf
End If
SetData "ErrCnt" & lEvtID, 0
SetData "ErrHistory" & lEvtID, ""
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "GOOD"
oBag.AddValue "EventID", "" & EVENT_BASE_PDC_MASTER_CONTACT
oAPI.AddItem oBag
End Sub
'******************************************************************************
Function GetData(strKey)
'
' Purpose: Retrieves data out of a varset. Uses the key to determine what
' data to retrieve.
'
' Arguments: strKey, the key of the data to retrieve
'
' Returns: String, the data to return or an empty string
'
On Error Resume Next
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Dim regData
regData = oReg.RegRead(REG_Key & "\" & strKey )
If IsNull(regData) or IsEmpty(regData) or regData = "" Then
GetData = ""
Else
GetData = regData
End If
Err.Clear
End Function
'******************************************************************************
Sub SetData(strKey, strData)
'
' Purpose: To store data in a varset. If the key exists then the data
' associated with that key is replaced, otherwise the key/data
' combination is added to the varset.
'
' Arguments: strKey, the key of the line to replace
' strData, the data to associate with the key
'
' Returns: Nothing
'
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Call oReg.RegWrite(REG_Key & "\" & strKey , strData )
Err.Clear
End Sub
' Start the main sub routine
Call Main() </Script></Contents>
<Unicode>1</Unicode>
</File>
</Files>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>
Home
CHT 
Show References: