<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 Err <> 0 Then
CreateEvent EVENT_ID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & _
SCRIPT_NAME & "' failed to create object " & _
"'McActiveDir.ActiveDirectory'." & GetErrorString(Err)
Else
objAD.Server = strComputer
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
ENU 
Show References: