<DataSourceModuleType ID="AD_General_Response.DataSource" Accessibility="Internal" Batching="false">
<Configuration>
<xsd:element name="IntervalSeconds" type="xsd:int"/>
<xsd:element name="TargetComputerName" type="xsd:string"/>
<xsd:element name="FailureThreshold" type="xsd:int"/>
<xsd:element name="LogSuccessEvent" type="xsd:boolean"/>
<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="int"/>
<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_General_Response.vbs$ $Config/TargetComputerName$ $Config/FailureThreshold$ $Config/LogSuccessEvent$ $Config/ManagementGroupName$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>AD_General_Response.vbs</Name>
<Contents><Script>
'*************************************************************************
' Script Name - AD General Response
'
' Purpose - Monitors the general responsiveness of active directory
'
' Assumptions - Script is run by a timed event
'
' Parameters - LogSuccessEvent - True/False value to indicates to log an
' an event for script success
' (useful for demos and debugging)
' FailureThreshold - The number of consecutive errors that
' must occur before a warning is
' generated. NOTE: This does not effect
' the daily count of errors.
'
' (c) Copyright 2001, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Dim oParams, TargetFQDNComputer, strFailureThreshold, bLogSuccessEvent, IsTargetAgentless
Dim bStandardLDAPBind
Dim bSSLLDAPBind
Set oParams = WScript.Arguments
if oParams.Count < 4 then
Wscript.Quit -1
End if
Dim oAPI,oBag
Set oAPI = CreateObject("Mom.ScriptAPI")
Err.Clear
Dim sStateValuePath
sStateValuePath= "HKLM\" & oAPI.GetScriptStateKeyPath(oParams(3))
' Registry Path to share data across scripts
Dim REG_Key
REG_Key = sStateValuePath & "\AD Management Pack\AD General Response"
Sub Main()
Dim objAD, objEvent, objADsObject
Dim lLastBind, lAverageBind, lCount, lFailureThreshold
Dim strMessage, strComputer
Dim arrLDAPBind(2)
Dim intBindSSL
Dim intNumberOfPorts
Dim bBindSuccessful
Dim SuccessCount
Dim dtStart
dtStart = Now
If Not(IsTargetAgentless) Then
lFailureThreshold = CLng(strFailureThreshold)
If ((1 > lFailureThreshold) Or (20 < lFailureThreshold)) Then
CreateEvent EVENTID_INVALID_PARAMETER, EVENT_TYPE_WARNING, "The script '" & _
SCRIPT_NAME & "' detected an invalid parameter." & vbCrLf & vbCrLf & _
"FailureThreshold must be greater than 1 and less than 20." & vbCrLf & _
"The current value of FailureThreshold is " & lFailureThreshold & "." & _
vbCrLf & vbCrLf & "FailureThreshold will be set to " & _
"4 for this execution of this script." & 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."
lFailureThreshold = 4
End If
'Extend the script to allow two optional parameters to determine if we should bind to the Standard port 389, bind to SSL port 636, or bind to both.
intNumberOfPorts = 1
If oParams.Count = 6 Then
bStandardLDAPBind = CBool(oParams(4))
bSSLLDAPBind = CBool(oParams(5))
If (bStandardLDAPBind) And (bSSLLDAPBind) Then
intBindSSL = 3
ElseIf (bStandardLDAPBind) And not(bSSLLDAPBind) Then
intBindSSL = 1
ElseIf not (bStandardLDAPBind) And (bSSLLDAPBind) Then
intBindSSL = 2
Else
errorString = "The script '" & SCRIPT_NAME & "' has incorrect parameters provided. " & _
"This is an unexpected error." & vbCrLf & vbCrLf & _
GetErrorString(Err.Number, Err.Description) & vbCrLf & vbCrLf & _
"Check your overrides for the AD General Response monitors to make sure that they are configured to bind to at least one port. The Overrideable Parameters are StandardLDAPBind and SSLLDAPBind. Verify that at least one of them is set to ""true""."
If intBindSSL = 3 Then
intNumberOfPorts = 2
arrLDAPBind(0) = "LDAP://" & strComputer & "/rootDSE"
arrLDAPBind(1) = "LDAP://" & strComputer & ":636/rootDSE"
ElseIf intBindSSL = 2 Then
arrLDAPBind(0) = "LDAP://" & strComputer & ":636/rootDSE"
Else
arrLDAPBind(0) = "LDAP://" & strComputer & "/rootDSE"
End If
Else
arrLDAPBind(0) = "LDAP://" & strComputer & "/rootDSE"
End If
err.Clear
Set objAD = CreateObject("McActiveDir.ActiveDirectory")
If (0 <> Err.Number) Or (Not(IsObject(objAD))) Then
Dim errorString
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "BAD"
oBag.AddValue "EventID", "" & EVENT_ID_AD_GENERAL_RESPONSE_NOTOK
oAPI.AddItem oBag
errorString = "The script '" & SCRIPT_NAME & "' failed to create object " & _
"'McActiveDir.ActiveDirectory'. This is an unexpected error." & vbCrLf & vbCrLf & _
GetErrorString(Err.Number, Err.Description) & 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."
'Iterate on the bind step for each port we want to bind to. (Test both standard and SSL ports is the only time we iterate more than once)
SuccessCount = 0
Dim I
For I = 0 to intNumberOfPorts-1
Set objADsObject = objAD.BindObject(arrLDAPBind(I))
If (Err.Number <> 0) Or (Not(IsObject(objADsObject))) Then
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "BAD"
oBag.AddValue "EventID", "" & EVENT_ID_AD_GENERAL_RESPONSE_NOTOK
oAPI.AddItem oBag
HandleScriptFailure "Failed to bind to '" & arrLDAPBind(I) & "'. This is an unexpected error." & vbCrLf & _
GetErrorString(Err.Number, Err.Description), _
lFailureThreshold
Else
bBindSuccessful = True
End If
Set objADsObject = Nothing
If bBindSuccessful Then
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "GOOD"
oBag.AddValue "EventID", "" & EVENT_ID_AD_GENERAL_RESPONSE_OK
oAPI.AddItem oBag
lLastBind = objAD.BindLast
' Write the perf data, after converting to seconds (originally milliseconds)
Set oBag = oAPI.CreateTypedPropertyBag(PerformanceDataType)
If InStr(arrLDAPBind(I),"636") Then
oBag.AddValue "StatusInstanceSSL", ""
Else
oBag.AddValue "StatusInstance", ""
End If
oBag.AddValue "StatusValue", "" & (lLastBind / 1000)
oAPI.AddItem oBag
SuccessCount = SuccessCount + 1
End If
bBindSuccessful = False
Next
'Verify the number of successes equals the number of ports tested before logging success
If SuccessCount = intNumberOfPorts Then
If bLogSuccessEvent Then
strMessage = "Active Directory bind time is " & lLastBind & " milliseconds." & vbCrLf & _
"The script '" & SCRIPT_NAME & "' completed successfully in " & _
DateDiff("s", dtStart, Now) & " seconds."
CreateEvent 25, EVENT_TYPE_INFORMATION, strMessage
End If
ResetConsecutiveErrorCount lFailureThreshold
End If
Set objAD = Nothing
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
oAPI.ReturnItems
'Else
'strMessage = "The script '" & SCRIPT_NAME & "' can only be executed by an event rule."
'CreateEvent 2, EVENT_TYPE_WARNING, strMessage
'End If
End Sub
'******************************************************************************
' Name: CreateEvent
'
' Purpose: Creates a MOM event
'
' Parameters: lEventID, the ID for the event
' lEventType, the severity for the event. See constants at head of file
' strMessage, the message for the event
'
' Return: nothing
'
Sub CreateEvent(lEventID, lEventType, strMessage)
oAPI.LogScriptEvent "AD General Response", lEventID, lEventType, strMessage
End Sub
'******************************************************************************
' Name: GetErrorString
'
' Purpose: Attempts to find the description for an error if no description
' is passed in.
'
' Parameters: lErrNumber, the error number
' strErrDescription, the error description (if known)
'
' Return: String, the description for the error. (Includes the error code.)
'
Function GetErrorString(lErrNumber, strErrDescription)
On Error Resume Next
If 0 >= Len(strErrDescription) 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 (lErrNumber And ErrorMask) = HiWord8007 Then
Dim oShell
Set oShell = CreateObject("WScript.Shell")
If IsObject(oShell) Then
Dim oExec
Set oExec = oShell.Exec("net helpmsg " & (lErrNumber And LoWordMask))
Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i < 5)
strErrDescription = strMessage
End If
End If
End If
GetErrorString = "The error returned was '" & strErrDescription & "' (0x" & Hex(lErrNumber) & ")"
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: strFailure, the description of the failure.
' lThreshold, the failure threshold.
'
' Return: Nothing
'
Sub HandleScriptFailure(strFailure, lThreshold)
On Error Resume Next
Dim lCurrentErrorCount,tmplConsecutiveErrors
Dim strErrorDescriptions, sameFailureIndex
tmplConsecutiveErrors = GetData("ErrorCount")
If tmplConsecutiveErrors = "" Then
lCurrentErrorCount = 0
Else
lCurrentErrorCount = Clng(tmplConsecutiveErrors)
End If
lCurrentErrorCount = lCurrentErrorCount + 1
' Update the error descriptions and increment the counters
strErrorDescriptions = GetData("ErrorDescriptions" )
' Compare the Failure that was previously saved on the Registry key to the new failure.
' If the new Failure is already contained on the Registry key, there is no need to save it again.
' This mitigates growth of the registry key's data.
sameFailureIndex = InStr(1, strErrorDescriptions, strFailure, vbTextCompare)
If sameFailureIndex = 0 or sameFailureIndex <> null Then
strErrorDescriptions = strFailure & vbCrLf & strErrorDescriptions
Call SetData("ErrorDescriptions", strErrorDescriptions)
End If
SetData "ErrorCount", lCurrentErrorCount
If lCurrentErrorCount <= lThreshold Then
' Generate an event detailing the errors that occurred.
Dim strMessage
strMessage = GetData("ErrorDescriptions")
strMessage = "While running '" & SCRIPT_NAME & "' the following consecutive errors were encountered:" & _
vbCrLf & strErrorDescriptions & vbCrLf & vbCrLf & _
"A message will be generated when the script succeeds which has details of all the " & _
"errors that have occurred. Look for a message from " & SCRIPT_NAME & " with ID = 1001."
CreateEvent EVENTID_SCRIPT_FAILURE, EVENT_TYPE_WARNING, strMessage
End If
End Sub
'******************************************************************************
' Name: ResetConsecutiveErrorCount
'
' Purpose: Resets the consecutive error count. Cal led when the script
' completes successfully.
'
' Parameters: lThreshold, the threshold for generating an alert from
' consecutive failures.
'
' Return: Nothing
'
Sub ResetConsecutiveErrorCount(lThreshold)
On Error Resume Next
Dim lConsecutiveErrors,tmplConsecutiveErrors
tmplConsecutiveErrors = GetData("ErrorCount")
if tmplConsecutiveErrors = "" Then
lConsecutiveErrors = 0
else
lConsecutiveErrors = Clng(tmplConsecutiveErrors)
end if
If lConsecutiveErrors >= lThreshold Then
' We have succeeded after a number of consecutive failures. Create a
' success event.
Dim strErrorDescriptions
strErrorDescriptions = GetData ( "ErrorDescriptions")
CreateEvent 1001, EVENT_TYPE_INFORMATION, "The script '" & SCRIPT_NAME & "' has succeeded following " & _
lConsecutiveErrors & " consecutive failures." & vbCrLf & _
"The errors reported were:" & vbCrLf & strErrorDescriptions
End If
SetData "ErrorCount", 0
SetData "ErrorDescriptions", ""
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: