<DataSourceModuleType ID="AD_Client_GC_Availability.DataSource" Accessibility="Internal">
<Configuration>
<xsd:element name="IntervalSeconds" type="xsd:int"/>
<xsd:element name="TargetComputerName" type="xsd:string"/>
<xsd:element name="MinimumAvailableGCs" type="xsd:int"/>
<xsd:element name="LogSuccessEvent" type="xsd:boolean"/>
<xsd:element name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" ParameterType="int" Selector="$Config/IntervalSeconds$"/>
<OverrideableParameter ID="LogSuccessEvent" ParameterType="string" Selector="$Config/LogSuccessEvent$"/>
<OverrideableParameter ID="MinimumAvailableGCs" ParameterType="int" Selector="$Config/MinimumAvailableGCs$"/>
<OverrideableParameter ID="TimeoutSeconds" ParameterType="int" Selector="$Config/TimeoutSeconds$"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="System!System.CommandExecuterPropertyBagSource">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<ApplicationName>%windir%\system32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>//nologo $file/AD_Client_GC_Availability.vbs$ $Config/TargetComputerName$ $Config/MinimumAvailableGCs$ $Config/LogSuccessEvent$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>AD_Client_GC_Availability.vbs</Name>
<Contents><Script>
'*************************************************************************
' Script Name - AD Client GC Availability
'
' Purpose - Attempts to contact all the configured GCs
' Generates alerts if either there are not enough GCs
' configured, or if not enough GCs are contactable
'
' Assumptions - Script is run by a timed event
'
' Parameters - MinimumAvailableGCs - the minimum number of GCs that must
' be available at all times
' LogSuccessEvent - Logs an event when the script completes.
'
' (c) Copyright 2002, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
' Variables
Dim IsTargetAgentless,TargetFQDNComputer
IsTargetAgentless = False
Dim oAPI,oBag
Set oAPI = CreateObject("Mom.ScriptAPI")
If Err <> 0 Then
ScriptError "initializing Mom.ScriptAPI."
End if
Call Main()
Sub Main()
On Error Resume Next
Dim dtStart
dtStart = Now
If Not(IsTargetAgentless) Then
Dim oParams, iMinimumConfiguredGCs, iMinimumAvailableGCs, bLogSuccessEvent
Set oParams = WScript.Arguments
if oParams.Count < 3 then
Wscript.Quit -1
End if
TargetFQDNComputer = oParams(0)
iMinimumAvailableGCs = CLng(oParams(1))'MinimumAvailableGCs
bLogSuccessEvent = CBool(oParams(2))'LogSuccessEvent
Dim strInvalidParam
If (iMinimumAvailableGCs < 0) Then
strInvalidParam = strInvalidParam & "MinimumAvailableGCs must be greater than 0." & _
"The current value of MinimumAvailableGCs is '" & _
iMinimumAvailableGCs & "'." & vbCrLf & _
"MinimumAvailableGCs will be set to the default value of 3" & _
" for this execution of this script." & vbCrLf
iMinimumAvailableGCs = 3
End If
If Len(strInvalidParam) > 0 Then
' Found invalid parameters
InvalidParam strInvalidParam
End If
Err.Clear
' Obtain the RootDSE of any GC that this client computer can connect to.
Dim oRootDSE
Set oRootDSE = GetObject("GC://RootDSE")
If 0 <> Err Then
ScriptError "attempting to bind to the RootDSE of any GC in the domain."
Else
' Now query the root DSE to get the site of the DC
Dim strSite, strServerName, strDNSHostName, strConfigNamingContext
strServerName = oRootDSE.Get("ServerName")
strDNSHostName = oRootDSE.Get("DNSHostName")
strConfigNamingContext = oRootDSE.Get("ConfigurationNamingContext")
If 0 <> Err Then
ScriptError "attempting to read the 'ConfigurationNamingContext' of the GC '" & strDNSHostName & "'."
Else
' Query AD to determine all the configured GCs
Dim oADOConn
Set oADOConn = CreateObject("ADODB.Connection")
If Err <> 0 Then
ScriptError "creating 'ADODB.Connection'."
Else
oADOConn.Provider = "ADSDsOObject"
oADOConn.Open "ADs Provider"
If Err <> 0 Then
ScriptError "initializing ADODB.Connection."
Else
Dim rsGCs, strQuery
strQuery = "<LDAP://" & strDNSHostName & "/CN=Sites," & strConfigNamingContext & ">;(&(objectClass=nTDSDSA)(options:1.2.840.113556.1.4.803:=1)(!isDeleted=TRUE));adspath,cn;subtree"
Set rsGCs = oADOConn.Execute(strQuery)
If 0 <> Err Then
ScriptError "executing the query '" & strQuery & "'."
Else
Dim oNTDSASettings, iAvailableGCs, strGCs, strUnavailableGCs
iAvailableGCs = 0
rsGCs.MoveFirst
Do Until rsGCs.EOF Or iAvailableGCs >= iMinimumAvailableGCs
Set oNTDSASettings = GetObject(rsGCs.Fields("adspath"))
Err.Clear
If IsObject(oNTDSASettings) Then
Dim oServer
Set oServer = GetObject(oNTDSASettings.Parent)
If 0 <> Err Then
ScriptError "getting the object: '" & oNTDSASettings.Parent & "'."
Else
Dim strGCDNSHostName
strGCDNSHostName = oServer.Get("DNSHostName")
strGCs = strGCs & strGCDNSHostName & vbCrLf
Dim oGC
Set oGC = GetObject("GC://" & strGCDNSHostName & "/RootDSE")
If 0 <> Err Then
strUnavailableGCs = strUnavailableGCs & strGCDNSHostName & vbCrLf
Else
' Attempt to retrieve a property from the object (to force ADSI to actually connect).
Dim strTemp
strTemp = oGC.Get("DNSHostName")
If 0 <> Err Then
strUnavailableGCs = strUnavailableGCs & strGCDNSHostName & vbCrLf
Else
iAvailableGCs = iAvailableGCs + 1
' See if the high performance counters are available
Dim oPerfOS, bUseHighPerfCounters, iTicksPerSecond
Set oPerfOS = GetObject("winmgmts:\\.\root\cimv2:Win32_PerfRawData_PerfOS_System=@")
If Err = 0 Then
iTicksPerSecond = oPerfOS.Frequency_PerfTime
If Err = 0 Then
bUseHighPerfCounters = True
End If
End If
Err.Clear
' Now perform the GC search get perf numbers
strQuery = "<LDAP://" & strTemp & "/" & strConfigNamingContext & ">;(cn=" & oServer.Get("cn") & ");adspath;subtree"
Dim rsGCSearchResults, dtSearchStart, iSearchStart
dtSearchStart = Now
If bUseHighPerfCounters Then
iSearchStart = oPerfOS.TimeStamp_PerfTime
End If
Set rsGCSearchResults = oADOConn.Execute(strQuery)
If Err <> 0 Then
ScriptError "executing the query: '" & strQuery & "'."
Else
rsGCSearchResults.MoveFirst
If Err <> 0 Then
ScriptError "performing the search: '" & strQuery & "'."
Else
' Record perf data for the search
Dim iSearchLength
If bUseHighPerfCounters Then
Set oPerfOS = GetObject("winmgmts:\\.\root\cimv2:Win32_PerfRawData_PerfOS_System=@")
iSearchLength = Round((oPerfOS.TimeStamp_PerfTime - iSearchStart) / iTicksPerSecond, 2)
Else
iSearchLength = DateDiff("s", dtSearchStart, Now)
End If
Set oBag= oAPI.CreateTypedPropertyBag(PerformanceDataType)
Call oBag.AddValue("StatusInstance",oServer.Get("cn") )
Call oBag.AddValue("StatusValue","" & iSearchLength )
Call oAPI.addItem(oBag)
End If
End If
End If
End If
End If
End If
rsGCs.MoveNext
Loop
Set oBag= oAPI.CreateTypedPropertyBag(StateDataType)
If iAvailableGCs < iMinimumAvailableGCs Then
'
' Create an event indicating we have not met the minimum
' threshold for available GCs.
'
Dim strFailureMessage
strFailureMessage = "There are not enough GCs available. "
If Len(strUnavailableGCs) > 0 Then
strFailureMessage = strFailureMessage & "The GCs that are configured " & _
"but could not be contacted are:" & vbCrLf & strUnavailableGCs
Else
strFailureMessage = strFailureMessage & "There are fewer GCs configured " & _
"than are specified as the minimum number of available GCs. " & vbCrLf & vbCrLf & _
"Available GCs: " & iAvailableGCs & vbCrLf & _
"Minimum GCs: " & iMinimumAvailableGCs
End If
'
' Remember that we're in this state so we can create a success event later.
'
Call oBag.AddValue("State","BAD" )
Call oBag.AddValue("EventID",EVENT_ID_FAILED_AVAILABLE_GCS )
Else
Dim strSuccessMessage
strSuccessMessage = "There are now enough GCs available." & vbCrLf & vbCrLf & _
"Available GCs: " & iAvailableGCs & vbCrLf & _
"Minimum GCs: " & iMinimumAvailableGCs
If iAvailableGCs >= iMinimumAvailableGCs And _
bLogSuccessEvent Then
CreateEvent EVENT_ID_SUCCESS, EVENT_TYPE_SUCCESS, _
"The script '" & SCRIPT_NAME & "' has completed successfully in " & _
DateDiff("s", dtStart, Now) & " second(s)." & vbCrLf & vbCrLf & _
"The GCs configured are:" & vbCrLf & strGCs
End If
End If
End If
End If
End If
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
Call oAPI.ReturnItems()
End Sub
'******************************************************************************
Function GetLocalSiteName()
'
' Purpose: To retrieve the site name for this computer.
'
' Returns: String, the site name (or an empty string if it cannot be determined)
'
Dim oADSysInfo
Set oADSysInfo = CreateObject("ADSystemInfo")
GetLocalSiteName = oADSysInfo.SiteName
End Function
'******************************************************************************
Sub CreateEvent(lEventID, lEventType, strMessage)
'
' Purpose: To generate a MOM event
'
' Arguments: lEventID, the event code
' lEventType, the severity of the event
' strMessage, the message to include in the event
'
On Error Resume Next
Call oAPI.LogScriptEvent("AD Client GC Availability",lEventID ,lEventType,strMessage)
End Sub
'******************************************************************************
Sub ScriptError(strContext)
'
' Purpose: To generate an alert for the current error and then throw the
' exception so it can be caught at a higher level.
'
' Arguments: strContext - the current context, this is added to the message
' that is alerted to the user
'
' Returns: nothing
'
Dim strError
strError = "The script '" & SCRIPT_NAME & "' encountered an error while " & strContext & _
GetErrorString(Err)
CreateEvent EVENT_ID_SCRIPT_FAILURE, EVENT_TYPE_WARNING, strError
End Sub
'******************************************************************************
Function GetErrorString(oErr)
'
' 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.)
'
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 & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
Sub InvalidParam(strError)
'
' Purpose: To generate an invalid parameter warning.
'
' Arguments: strError, the description of the error
'
CreateEvent EVENT_ID_INVALID_PARAMETER, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & _
"' detected an error with one or more " & _
"parameters. The error is:" & vbCrLf & strError & 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 Sub </Script></Contents>
<Unicode>1</Unicode>
</File>
</Files>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>
Home
PTB 
Show References: