Error threshold for the number of available Global Catalogs
WarnThreshold
int
$Config/WarnThreshold$
Warning threshold for the number of available Global Catalogs
TimeoutSeconds
int
$Config/TimeoutSeconds$
Timeout Seconds
Source Code:
<DataSourceModuleType ID="Microsoft.Windows.AD.DomainMemberPerspective.Availability.GlobalCatalog.DataSource" Accessibility="Internal">
<Configuration>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="IntervalSeconds" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ErrorThreshold" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="WarnThreshold" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" ParameterType="int" Selector="$Config/IntervalSeconds$"/>
<OverrideableParameter ID="ErrorThreshold" ParameterType="int" Selector="$Config/ErrorThreshold$"/>
<OverrideableParameter ID="WarnThreshold" ParameterType="int" Selector="$Config/WarnThreshold$"/>
<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/GlobalCatalogAvailability.vbs$ $Config/ErrorThreshold$ $Config/WarnThreshold$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>GlobalCatalogAvailability.vbs</Name>
<Contents><Script>'*************************************************************************
' Script Name - GlobalCatalogAvailability
'
' Purpose - Ensure that the minimum number of GCs specified are online
'
' (c) Copyright 2014, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Option Explicit
SetLocale("en-us")
Sub Main()
Dim oAPI, oBag, oParams, oRootDSE, rsGCs, strQuery, sError
Dim iMinimumConfiguredGCs, iWarnAvailableGCs, iErrorAvailableGCs, oADOConn
Dim strDNSHostName, strConfigNamingContext, strFailureMessage
Dim oNTDSASettings, iAvailableGCs
Set oAPI = CreateObject("Mom.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
Set oParams = WScript.Arguments
if oParams.Count <> 2 then
sError = "The number of command line arguments is incorrect: " & vbCrLf & _
"Expected: 2" & vbCrLf & _
"Actual: " & oParams.Count
if iErrorAvailableGCs < 1 then
iErrorAvailableGCs = 1
End if
iWarnAvailableGCs = CInt(oParams(1))
if iWarnAvailableGCs < 1 then
iWarnAvailableGCs = 2
End if
On Error Resume Next
' Obtain the RootDSE of any GC that this client computer can connect to.
Set oRootDSE = GetObject("GC://RootDSE")
If 0 <> Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to bind to the rootDSE of any GC in the domain." & GetErrorString(Err)
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
End If
' Now query the root DSE to get the site of the DC
strDNSHostName = oRootDSE.Get("DNSHostName")
strConfigNamingContext = oRootDSE.Get("ConfigurationNamingContext")
If 0 <> Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Error attempting to read the 'ConfigurationNamingContext' of the GC '" & strDNSHostName & "'." & GetErrorString(Err)
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
End If
' Query AD to determine all the configured GCs
Set oADOConn = CreateObject("ADODB.Connection")
If Err <> 0 Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Error creating an ADODB connection." & GetErrorString(Err)
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
End If
oADOConn.Provider = "ADSDsOObject"
oADOConn.Open "ADs Provider"
If Err <> 0 Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Error initializing the ADODB connection." & GetErrorString(Err)
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
End If
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
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Error executing the following query: '" & strQuery & "'." & GetErrorString(Err)
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
End If
iAvailableGCs = 0
rsGCs.MoveFirst
Do Until rsGCs.EOF Or iAvailableGCs >= iWarnAvailableGCs
Set oNTDSASettings = GetObject(rsGCs.Fields("adspath"))
Err.Clear
If IsObject(oNTDSASettings) Then
Dim oServer, strGCDNSHostName, oGC, strTemp, oPerfOS
Set oServer = GetObject(oNTDSASettings.Parent)
If 0 <> Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Error getting the following object: '" & oNTDSASettings.Parent & "'." & GetErrorString(Err)
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
End If
strGCDNSHostName = oServer.Get("DNSHostName")
Set oGC = GetObject("GC://" & strGCDNSHostName & "/RootDSE")
' Attempt to retrieve a property from the object (to force ADSI to actually connect).
strTemp = oGC.Get("DNSHostName")
If 0 = Err Then
iAvailableGCs = iAvailableGCs + 1
End If
End If
rsGCs.MoveNext
Loop
If iAvailableGCs < iErrorAvailableGCs Then
strFailureMessage = "The number of GCs available is lower than the specified threshold." & vbCrLf & _
"Available GCs: " & iAvailableGCs & vbCrLf & _
"Error Threshold: " & iErrorAvailableGCs & vbCrLf & _
"Warning Threshold: " & iWarnAvailableGCs
oBag.AddValue "State","ERROR"
oBag.AddValue "ErrorString", strFailureMessage
oAPI.AddItem oBag
ElseIf iAvailableGCs < iWarnAvailableGCs Then
strFailureMessage = "The number of GCs available is lower than the specified threshold." & vbCrLf & _
"Available GCs: " & iAvailableGCs & vbCrLf & _
"Error Threshold: " & iErrorAvailableGCs & vbCrLf & _
"Warning Threshold: " & iWarnAvailableGCs
oBag.AddValue "State","WARN"
oBag.AddValue "ErrorString", strFailureMessage
oAPI.AddItem oBag
Else
oBag.AddValue "State", "GOOD"
oAPI.AddItem oBag
End If
oAPI.ReturnItems
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
Home
ENU 
Show References: