<DataSourceModuleType ID="AD_Op_Master_Response.DataSource" Accessibility="Internal" Batching="false">
<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:string"/>
<xsd:element name="SuccessCount" type="xsd:string"/>
<xsd:element name="ManagementGroupName" type="xsd:string"/>
<xsd:element name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" Selector="$Config/IntervalSeconds$" ParameterType="int"/>
<OverrideableParameter ID="LogSuccessEvent" Selector="$Config/LogSuccessEvent$" ParameterType="string"/>
<OverrideableParameter ID="FailureThreshold" Selector="$Config/FailureThreshold$" ParameterType="string"/>
<OverrideableParameter ID="SuccessCount" Selector="$Config/SuccessCount$" ParameterType="string"/>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
</OverrideableParameters>
<ModuleImplementation Isolation="Any">
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="System!System.CommandExecuterPropertyBagSource">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<ApplicationName>%windir%\system32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>//nologo $file/AD_Op_Master_Response.vbs$ $Config/TargetComputerName$ $Config/LogSuccessEvent$ $Config/FailureThreshold$ $Config/SuccessCount$ $Config/ManagementGroupName$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>AD_Op_Master_Response.vbs</Name>
<Contents><Script>
'*************************************************************************
' Script Name - AD Op Master Response
'
' Purpose - Determines if the op masters are available and
' monitors their 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 2001, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
If Not(IsTargetAgentless) Then
dtStart = Now
Dim lngPingTime, lngBindLast, bPing, bBind
strComputer = TargetFQDNComputer
Dim strInvalidParams
Err.Clear
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 4 for this execution " & _
"of this script." & vbCrLf & vbCrLf
lFailLimit = 4
End If
Err.Clear
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."
strMaster = objAD.PDCMaster
bPing=false
bBind=false
If Trim(strMaster) <> "" Then
PingAndBind objAD, _
strMaster, _
1, _
"PDC Op Master", _
"Op Master PDC Last Ping", _
"Op Master PDC Last Bind", _
EVENT_BASE_PDC_MASTER, lngPingTime, lngBindLast, bPing, bBind
If bPing Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "PDC Op Master")
Call oBag.AddValue("StatusCounter", "Op Master PDC Last Ping")
Call oBag.AddValue("StatusInstance","PDC ping latency")
Call oBag.AddValue("StatusValue", "" & (lngPingTime / 1000) )
Call oAPI.addItem(oBag)
End if
If bBind Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "PDC Op Master")
Call oBag.AddValue("StatusCounter", "Op Master PDC Last Bind")
Call oBag.AddValue("StatusInstance","PDC bind latency")
Call oBag.AddValue("StatusValue", "" & (lngBindLast / 1000) )
Call oAPI.addItem(oBag)
End if
Else
strMessage = "The script '" & SCRIPT_NAME & "' could not determine the PDC Op Master."
If Err <> 0 Then
strMessage = strMessage & GetErrorString(Err)
End If
CreateEvent EVENT_BASE_PDC_MASTER, EVENT_TYPE_ERROR, strMessage
End If
' Check to see if we have should run the rest of the tests
strMaster = objAD.DomainNamingMaster
bPing=false
bBind=false
If Trim(strMaster) <> "" Then
PingAndBind objAD, _
strMaster, _
lSuccessCount, _
"Domain Naming Op Master", _
"Op Master Domain Naming Last Ping", _
"Op Master Domain Naming Last Bind", _
EVENT_BASE_DOMAIN_NAMING_MASTER, lngPingTime, lngBindLast, bPing, bBind
If bPing Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "Domain Naming Op Master")
Call oBag.AddValue("StatusCounter", "Op Master Domain Naming Last Ping")
Call oBag.AddValue("StatusInstance","Domain Naming Master ping latency")
Call oBag.AddValue("StatusValue", "" & (lngPingTime / 1000) )
Call oAPI.addItem(oBag)
End if
If bBind Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "Domain Naming Op Master")
Call oBag.AddValue("StatusCounter", "Op Master Domain Naming Last Bind")
Call oBag.AddValue("StatusInstance","Domain Naming Master bind latency")
Call oBag.AddValue("StatusValue", "" & (lngBindLast / 1000) )
Call oAPI.addItem(oBag)
End if
Else
strMessage = "The script '" & SCRIPT_NAME & "' could not determine the domain naming Op Master."
If Err <> 0 Then
strMessage = strMessage & GetErrorString(Err)
End If
HandleScriptFailure EVENT_BASE_DOMAIN_NAMING_MASTER, strMessage
End If
If Trim(strMaster) <> "" Then
PingAndBind objAD, _
strMaster, _
lSuccessCount, _
"Infrastructure Op Master", _
"Op Master Infrastructure Last Ping", _
"Op Master Infrastructure Last Bind", _
EVENT_BASE_INFRASTRUCTURE_MASTER, lngPingTime, lngBindLast, bPing, bBind
If bPing Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "Infrastructure Op Master")
Call oBag.AddValue("StatusCounter", "Op Master Infrastructure Last Ping")
Call oBag.AddValue("StatusInstance","Infrastructure Master ping latency")
Call oBag.AddValue("StatusValue", "" & (lngPingTime / 1000) )
Call oAPI.addItem(oBag)
End if
If bBind Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "Infrastructure Op Master")
Call oBag.AddValue("StatusCounter", "Op Master Infrastructure Last Bind")
Call oBag.AddValue("StatusInstance","Infrastructure Master bind latency")
Call oBag.AddValue("StatusValue", "" & (lngBindLast / 1000) )
Call oAPI.addItem(oBag)
End if
Else
strMessage = "The script '" & SCRIPT_NAME & "' could not determine the infrastructure Op Master."
If Err <> 0 Then
strMessage = strMessage & GetErrorString(Err)
End If
HandleScriptFailure EVENT_BASE_INFRASTRUCTURE_MASTER, strMessage
End If
If Trim(strMaster) <> "" Then
PingAndBind objAD, _
strMaster, _
lSuccessCount, _
"RID Op Master", _
"Op Master RID Last Ping", _
"Op Master RID Last Bind", _
EVENT_BASE_RID_MASTER, lngPingTime, lngBindLast, bPing, bBind
If bPing Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "RID Op Master")
Call oBag.AddValue("StatusCounter", "Op Master RID Last Ping")
Call oBag.AddValue("StatusInstance","RID Master ping latency")
Call oBag.AddValue("StatusValue", "" & (lngPingTime / 1000 ))
Call oAPI.addItem(oBag)
End if
If bBind Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "RID Op Master")
Call oBag.AddValue("StatusCounter", "Op Master RID Last Bind")
Call oBag.AddValue("StatusInstance","RID Master bind latency")
Call oBag.AddValue("StatusValue", "" & (lngBindLast / 1000) )
Call oAPI.addItem(oBag)
End if
Else
strMessage = "The script '" & SCRIPT_NAME & "' could not determine the RID Op Master."
If Err <> 0 Then
strMessage = strMessage & GetErrorString(Err)
End If
HandleScriptFailure EVENT_BASE_RID_MASTER, strMessage
End If
If Trim(strMaster) <> "" Then
PingAndBind objAD, _
strMaster, _
lSuccessCount, _
"Schema Op Master", _
"Op Master Schema Last Ping", _
"Op Master Schema Last Bind", _
EVENT_BASE_SCHEMA_MASTER, lngPingTime, lngBindLast, bPing, bBind
If bPing Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "Schema Op Master")
Call oBag.AddValue("StatusCounter", "Op Master Schema Last Ping")
Call oBag.AddValue("StatusInstance","Schema Master ping latency")
Call oBag.AddValue("StatusValue", "" & (lngPingTime / 1000) )
Call oAPI.addItem(oBag)
End if
If bBind Then
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusObject", "Schema Op Master")
Call oBag.AddValue("StatusCounter", "Op Master Schema Last Bind")
Call oBag.AddValue("StatusInstance","Schema Master bind latency")
Call oBag.AddValue("StatusValue", "" & (lngBindLast / 1000 ))
Call oAPI.addItem(oBag)
End if
Else
strMessage = "The script '" & SCRIPT_NAME & "' could not determine the schema Op Master."
If Err <> 0 Then
strMessage = strMessage & GetErrorString(Err)
End If
HandleScriptFailure EVENT_BASE_SCHEMA_MASTER, strMessage
End If
End If
if bEventRelCreated = true Then
if bEventBad= false then
set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "GOOD"
oBag.AddValue "EventID", EVENT_GOOD_STATE_ID
oAPI.AddItem oBag
End if
End If
If bEventCreated = false then
set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "GOOD"
oBag.AddValue "EventID", EVENT_GOOD_STATE_ID
oAPI.AddItem oBag
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
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(lEvtID, lngEventType, strMessage)
oAPI.LogScriptEvent "AD Op Master Response", lEvtID, lngEventType, strMessage
bEventCreated = true
if (lEvtID = EVENT_BASE_PDC_MASTER or lEvtID = EVENT_BASE_DOMAIN_NAMING_MASTER or _
lEvtID = EVENT_BASE_INFRASTRUCTURE_MASTER or lEvtID = EVENT_BASE_RID_MASTER or _
lEvtID = EVENT_BASE_SCHEMA_MASTER) Then
bEventRelCreated=true
End If
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, lngPingTime, lngBindLast, bPing, bBind)
On Error Resume Next
Dim strMaster
strMaster = LCase(strDC)
' Check to see if we either failed last time, or our success count >= lSuccessWait
Dim lSuccessCount, tempStr
tempStr = GetData("SuccessCount" & lEvtID)
if tempStr <> "" Then
lSuccessCount = CDbl(tempStr)
Else
lSuccessCount = 0
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
strIPAddress = objAD.GetIPAddress(strMaster)
Dim bBindSuccess, bPingSuccess, bDNSSuccess, lAttemptCount
bBindSuccess = False
bPingSuccess = False
bDNSSuccess = False
If Len(strIPAddress) > 0 Then
bDNSSuccess = True
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
bPing=true
Dim oMaster
Do
Set oMaster = objAD.BindObject("LDAP://" & strMaster & "/RootDSE")
If Err = 0 And IsObject(oMaster) Then
bBindSuccess = True
Set oMaster = nothing
' Create Performance Data in seconds rather than milliseconds
lngBindLast = objAD.BindLast
bBind=true
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 lEvtID, strMessage
Else
Dim oWMI, oX
If True = bDNSSuccess Then
' Can we ping the default gateway?
Dim bDefaultGatewayContactable
Dim strDefaultGateway
Set oWMI = GetObject("winmgmts:").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 UBound(oX.DefaultIPGateway)
lDefaultGatewayPingTime = objAD.Ping(oX.DefaultIPGateway(iIndex))
strDefaultGateway = oX.DefaultIPGateway(iIndex)
If (lDefaultGatewayPingTime >= 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 (lDefaultGatewayPingTime >= 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 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:").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 lEvtID, strMessage
End If
End If
Else
ResetConsecutiveErrCnt 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: 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(lEvtID, strFailure)
On Error Resume Next
PerformDailyCheck lEvtID
Dim lCurrentErrCnt, tempStr
tempStr = GetData("ErrCnt" & lEvtID) + 1
if tempStr <> "" Then
lCurrentErrCnt = CDbl(tempStr)
Else
lCurrentErrCnt = 0
End if
Dim strHistory
strHistory = CStr(GetData("ErrHistory" & lEvtID)) & Now() & " : " & 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 = "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 & vbCrLf & vbCrLf & _
"To see all events generated by this script, look in the " & _
"public view: 'AD Op Master Response Events'."
If (lEvtID = EVENT_BASE_PDC_MASTER or lEvtID = EVENT_BASE_DOMAIN_NAMING_MASTER or _
lEvtID = EVENT_BASE_INFRASTRUCTURE_MASTER or lEvtID = EVENT_BASE_RID_MASTER or _
EVENT_BASE_SCHEMA_MASTER) Then
set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "BAD"
oBag.AddValue "EventID", EVENT_BAD_STATE_ID
oBag.AddValue "ErrorString", strMessage
oAPI.AddItem oBag
bEventBad = true
End if
' Increment the counters
Dim temp
SetData "ErrCnt" & lEvtID, lCurrentErrCnt
tempStr = GetData("DailyErrCnt" & lEvtID)
if tempStr <> "" Then
temp = CDbl(tempStr)
Else
temp = 0
End if
SetData "DailyErrCnt" & lEvtID, temp + 1
' 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: PerformDailyCheck
'
' Purpose: Updates the daily count of errors that occur. If this is a new
' day, then we generate an event detailing the number of errors
' that have occurred and reset the count. An event is only
' generated when there are errors for that day.
'
' Parameters: lEvtID, an event ID for the error type being dealt with.
' Used to segregate failures for each Op Master.
'
Sub PerformDailyCheck(lEvtID)
On Error Resume Next
Dim strMessage, strErrDesc
Dim lCurrentErrCnt, dtCountDate, tempStr
dtCountDate = GetData("DailyErrCntDate" & lEvtID)
tempStr = GetData("DailyErrCnt" & lEvtID)
if tempStr <> "" Then
lCurrentErrCnt = CDbl(tempStr)
Else
lCurrentErrCnt = 0
End if
If Not(IsEmpty(dtCountDate)) And IsDate(dtCountDate) Then
' Only check the date part (ignore the time)
If DateValue(dtCountDate) <> DateValue(Now) Then
' Today is a new day, generate an event (if the count > 0)
If lCurrentErrCnt > 0 Then
strMessage = "While running '" & SCRIPT_NAME & "' " & lCurrentErrCnt & _
" errors were generated on " & CStr(DateValue(dtCountDate))
' Create the event manually, we want to set the date and time...need to check for time setting
CreateEvent lEvtID + 1, EVENT_TYPE_INFORMATION, strMessage
' Dim oEvent
' Set oEvent = ScriptContext.CreateEvent
'
' Set event properties
' oEvent.Message = strMessage
' oEvent.EventNumber = lEvtID + 1
' oEvent.EventType = EVENT_TYPE_INFORMATION
'' oEvent.LocalTime = CDate(CDbl(DateValue(dtCountDate)) + CDbl(TimeValue("23:59")))
' Submit the event
' ScriptContext.Submit oEvent
' Set oEvent = Nothing
End If
' Reset the daily error count.
SetData "DailyErrCnt" & lEvtID, 0
SetData "DailyErrCntDate" & lEvtID, CStr(DateValue(Now))
End If
Else
' First time the script has got here
SetData "DailyErrCnt" & lEvtID, 0
SetData "DailyErrCntDate" & lEvtID, CStr(DateValue(Now))
SetData "SuccessCount" & lEvtID, 0
End If
End Sub
'******************************************************************************
' Name: ResetConsecutiveErrCnt
'
' Purpose: Resets the consecutive error count. Called when the script
' completes successfully.
'
' Parameters: lEvtID, an event ID for the error type being dealt with.
' Used to segregate failures for each Op Master.
'
Sub ResetConsecutiveErrCnt(lEvtID)
On Error Resume Next
Dim lConsecutiveErrors, tempStr
tempStr = GetData("ErrCnt" & lEvtID)
if tempStr <> "" Then
lConsecutiveErrors = CDbl(tempStr)
Else
lConsecutiveErrors = 0
End if
If lConsecutiveErrors >= lFailLimit Then
' We have succeeded after a number of consecutive failures. Create a
' success event.
CreateEvent lEvtID, EVENT_TYPE_SUCCESS, "The script '" & SCRIPT_NAME & "' has succeeded following " & _
lConsecutiveErrors & " consecutive failures." & vbCrLf & _
"To view all the events generated by this script see the " & _
"public view: 'AD Op Master Response Events'."
End If
SetData "ErrCnt" & lEvtID, 0
SetData "ErrHistory" & lEvtID, ""
PerformDailyCheck lEvtID
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
Home
RUS 
Show References: