<DataSourceModuleType ID="AD_Global_Catalog_Search_Response.DataSource" Accessibility="Internal" Batching="false">
<Configuration>
<xsd:element name="IntervalSeconds" type="xsd:int"/>
<xsd:element name="TargetComputerName" type="xsd:string"/>
<xsd:element name="Query" type="xsd:string"/>
<xsd:element name="LogSuccessEvent" type="xsd:boolean"/>
<xsd:element name="FailureThreshold" type="xsd:int"/>
<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="Query" Selector="$Config/Query$" 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_Global_Catalog_Search_Response.vbs$ $Config/TargetComputerName$ $Config/Query$ $Config/LogSuccessEvent$ $Config/FailureThreshold$ $Config/ManagementGroupName$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>AD_Global_Catalog_Search_Response.vbs</Name>
<Contents><Script>
'*************************************************************************
' Script Name - AD Global Catalog Search Response
'
' Purpose - Monitors the responsiveness of global catalog queries
'
' 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)
' Query - The query to perform
' FailureThreshold - The number of consecutive failures that
' must occur before an alert is raised
' (This only applies to errors encountered
' during the test, scripting and other
' runtime errors are reported immediately)
'
' (c) Copyright 2001, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
' Other Variables
Dim oParams, IsTargetAgentless, strFailureThreshold,TargetFQDNComputer
Set oParams = WScript.Arguments
if oParams.Count < 5 then
Wscript.Quit -1
End if
Dim oAPI, objAD, objParams, objEvent, oBag
Set oAPI = CreateObject("Mom.ScriptAPI")
Err.Clear
Dim sStateValuePath
sStateValuePath= "HKLM\" & oAPI.GetScriptStateKeyPath(oParams(4))
Dim oReg
oReg = NULL
Dim REG_Key
REG_Key = sStateValuePath & "\AD Management Pack\AD Global Catalog Search Response"
Sub Main()
Dim objAD, objParams
Dim bLogSuccessEvent, dtStart
Dim lngSearchTime, lngObjectCount
Dim strMessage, strComputer, strQuery
If Not(IsTargetAgentless) Then
On Error Resume Next
dtStart = Now
lFailLimit = CLng(strFailureThreshold)
If lFailLimit < 1 Then
CreateEvent EVENT_ID_INVALID_PARAM, EVENT_TYPE_WARNING, "The script '" & _
SCRIPT_NAME & "' detected an invalid parameter. The " & _
"parameter 'FailureThreshold' must be greater than or " & _
"equal to 1." & vbCrLf & vbCrLf & "'FailureThreshold' " & _
"will be set to 3 for this execution of the script."
lFailLimit = 3
End If
strComputer = LCase(TargetFQDNComputer)
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."
lngObjectCount = objAD.SearchGlobalCatalog(strQuery)
If CheckError("failed to perform a Global Catalog search.", 1027, EVENT_TYPE_ERROR) Then
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "GOOD"
oBag.AddValue "EventID", "" & EVENT_ID_AD_GLOBAL_CATALOG_SEARCH_OK
oAPI.AddItem oBag
lngSearchTime = objAD.GlobalCatalogSearchTime
Set oBag = oAPI.CreateTypedPropertyBag(PerformanceDataType)
oBag.AddValue "StatusInstance", ""
oBag.AddValue "StatusValue", "" & Round(lngSearchTime /1000, 2)
oAPI.AddItem oBag
If bLogSuccessEvent Then
strMessage = "The query '" & strQuery & "' returned " & lngObjectCount & " objects in " & lngSearchTime & " milliseconds." & vbCrLf & _
"The script '" & SCRIPT_NAME & "' completed in " & DateDiff("s", dtStart, Now) & " seconds."
CreateEvent EVENT_ID_AD_GLOBAL_CATALOG_SEARCH_OK, EVENT_TYPE_INFORMATION, strMessage
End If
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: lngEventID, the ID for the event
' lngEventType, the severity for the event. See constants at head of file
' strMessage, the message for the event
'
' Return: nothing
'
Sub CreateEvent(lngEventID, lngEventType, strMessage)
oAPI.LogScriptEvent "AD Global Catalog Search Response", lngEventID, lngEventType, strMessage
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 = vbCrLf & vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
Function CheckError(strDescription, lEventID, lEventType)
'
' Purpose: If Err <> 0 Then the test failed, generate an event indicating that
' the test failed. If three consecutive failures have occurred then
' generate an alert indicating this fact. If the test succeeded then
' clear the consecutive error count, if we are in an error state,
' generate a success event.
'
' Arguments: strDescription - the description of what failed.
' lEventID - the event ID to raise (if required)
' lEventType - the type of event (warning, error etc.) if required
'
' Returns: nothing
'
Dim lError, strError, strSource
lError = Err.number
strError = Err.Description
If lError <> 0 Then
CheckError = False
Else
CheckError = True
End If
On Error Resume Next
Dim lConsecutiveErrors, tmplConsecutiveErrors
tmplConsecutiveErrors = GetData("ErrCnt")
if tmplConsecutiveErrors = "" Then
lConsecutiveErrors = 0
else
lConsecutiveErrors = CLng(tmplConsecutiveErrors)
End if
If lError <> 0 Then
lConsecutiveErrors = lConsecutiveErrors + 1
If lConsecutiveErrors <= lFailLimit Then
SetData "ErrDesc", CStr(GetData("ErrDesc")) & vbCrLf & Now() & " : " & _
strError & " (0x" & Hex(lError) & ")"
End If
If lConsecutiveErrors = lFailLimit Then
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "BAD"
oBag.AddValue "EventID", "" & EVENT_ID_AD_GLOBAL_CATALOG_SEARCH_NOTOK
oAPI.AddItem oBag
' 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 test succeeds. " & _
"Look for a success alert from '" & SCRIPT_NAME & _
"' with ID = " & EVENT_ID_TEST_FAILED & "." & vbCrLf & vbCrLf & _
"To see the errors look for events from '" & SCRIPT_NAME & _
"' with event ID " & EVENT_ID_TEST_FAILED & "." & _
vbCrLf & vbCrLf & "The last " & lFailLimit & " errors were:"
strMessage = strMessage & GetData("ErrDesc")
CreateEvent EVENT_ID_AD_GLOBAL_CATALOG_SEARCH_NOTOK, EVENT_TYPE_WARNING, strMessage
End If
' Increment the counters
SetData "ErrCnt", lConsecutiveErrors
' Set the SuccessCount to 0 so that we'll execute the test again
' the next time the script runs
SetData "SuccessCount", 0
Else
If lConsecutiveErrors >= lFailLimit Then
' We have succeeded after a number of consecutive failures. Create a
' success event.
CreateEvent EVENT_ID_TEST_FAILED, EVENT_TYPE_INFORMATION, "The script '" & SCRIPT_NAME & "' has succeeded following " & _
lConsecutiveErrors & " consecutive failures." & vbCrLf
End If
SetData "ErrCnt", 0
SetData "ErrDesc", ""
End If
End Function
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: