<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
HandleScriptFailure 0, _
"The script '" & SCRIPT_NAME & "' failed to create object " & _
"'McActiveDir.ActiveDirectory'. This is an unexpected error." & vbCrLf & _
GetErrorString(Err)
Else
objAD.Server = strComputer
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","")
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","")
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 + OFFSET_CANNOT_DETERMINE, 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","")
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","")
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","")
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","")
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","")
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","")
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","")
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","")
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 GetUBound(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
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
oAPI.AddItem oBag
bEventBad = true
End if
' 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'."
CreateEvent lEvtID, EVENT_TYPE_WARNING, strMessage
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, DateValue(Now)
End If
Else
' First time the script has got here
SetData "DailyErrCnt" & lEvtID, 0
SetData "DailyErrCntDate" & lEvtID, 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
ENU 
Show References: