A kötési kísérlet sikertelen ismétléseinek azon száma, amely már riasztást vált ki
TargetLocalSite
string
$Config/TargetLocalSite$
Ezt a figyelőt úgy állítsa be, hogy csak a tartománytaggal egy helyen lévő tartományvezérlők állapotát ellenőrizze.
Source Code:
<DataSourceModuleType ID="Microsoft.Windows.AD.DomainMemberPerspective.Availability.DomainControllerHealth.DataSource" Accessibility="Internal" Batching="false">
<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="TimeoutSeconds" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="BindIterations" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TargetLocalSite" type="xsd:string"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" Selector="$Config/IntervalSeconds$" ParameterType="int"/>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
<OverrideableParameter ID="BindIterations" Selector="$Config/BindIterations$" ParameterType="int"/>
<OverrideableParameter ID="TargetLocalSite" Selector="$Config/TargetLocalSite$" ParameterType="string"/>
</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/DomainControllerHealthVerifier.vbs$ $Config/BindIterations$ $Config/TargetLocalSite$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>DomainControllerHealthVerifier.vbs</Name>
<Contents><Script>'*************************************************************************
' Script Name - DomainControllerHealthVerifier.vbs
'
' Purpose - Ensure that the DCs in the domain are responding properly
'
' (c) Copyright 2014, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Option Explicit
SetLocale("en-us")
Dim oAPI, oBag
Set oAPI = CreateObject("Mom.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
Sub Main()
Dim oParams
Dim sError
Dim iRetryCount
Dim bSiteSpecific
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
Call oAPI.Return(oBag)
Exit Sub
Else
iRetryCount = oParams(0)
End If
If LCase(oParams(1)) = "true" Then
bSiteSpecific = true
Else
bSiteSpecific = false
End If
On Error Resume Next
' Obtain the RootDSE of any GC that this client computer can connect to.
Dim oRootDSE
Set oRootDSE = GetObject("LDAP://RootDSE")
If 0 <> Err Then
HandleError Err, "Unable to bind to the rootDSE of any DC in the domain."
End If
Dim sDomainDN, sConfigNC
sDomainDN = oRootDSE.Get("defaultNamingContext")
sConfigNC = oRootDSE.Get("ConfigurationNamingContext")
Dim oDomain
Set oDomain = GetObject("LDAP://" & sDomainDN)
If 0 <> Err Then
HandleError Err, "Unable to bind to the domain DN: " & sDomainDN & "."
End If
'Get list of all domain controllers in the forest
Dim oADODBConn, oADODBcmd
Set oADODBConn = CreateObject("ADODB.Connection")
Set oADODBcmd = CreateObject("ADODB.Command")
oADODBConn.Provider = "ADsDSOObject;"
oADODBConn.Open
oADODBcmd.ActiveConnection = oADODBConn
Dim sldapQuery
If bSiteSpecific Then
Dim oADSysInfo, sSiteName
Set oADSysInfo = CreateObject("ADSystemInfo")
sSiteName = oADSysInfo.SiteName
If 0 <> Err Then
HandleError Err, "Unable to get the local site name using ADSystemInfo"
End If
If sSiteName = "" Then
HandleError Err, "No Site Defined for this machine"
End If
sldapQuery = "<LDAP://CN=Servers,CN=" & sSiteName & ",CN=Sites," & sConfigNC & _
">;((objectClass=nTDSDSA));ADsPath;subtree"
Else
sldapQuery = "<LDAP://" & sConfigNC & _
">;((objectClass=nTDSDSA));ADsPath;subtree"
End If
Dim oDCList, oDC
Set oDCList = oADODBcmd.Execute
If 0 <> Err Then
HandleError Err, "Error attempting to get the list of all the domain controllers for domain "&sDomainDN&"."
End If
Dim oDCRootDSE, oDCGCRootDSE
Dim sDCName, bPass, bMonitorPass
bMonitorPass = True
Do While oDCList.EOF <> True
bPass = True
set oDC = getobject(getobject(oDCList(0)).Parent)
' Get the DC's FQDN
sDCName = oDC.dNSHostName
' Check if DC responds to ping requests if so then verify that the DC
' is advertising by checking to see if the Sysvol is available
' if it is advertising then attempt to bind to the DC.
' if the DC is not responding to ping or advertising then client machines
' will not attempt to connect to it...thus we can ignore this DC.
If PingServer(sDCName) Then
' Check to see if the sysvol is available if it fails for a DC we ignore the DC because
' we rely on other monitors to fire if a domain controller fails to share sysvol.
' We use this check to determine if the DC is advertising.
If (CheckSysvol(sDCName)) Then
' To make sure that any bind failures are not just noise we will retry the Bind
Dim i
For i = 1 To iRetryCount
Err.Clear
' Bind to RootDSE of the DC
Set oDCRootDSE=GetObject("LDAP://" & sDCName & "/RootDSE")
If 0 <> Err Then
bPass = False
oAPI.LogScriptEvent "DomainControllerHealthVerifier.vbs", 103, 2, "LDAP Bind Failure: " & Err.Description
Err.Clear
Else
' DC Bind succeeded, set bPass to true, and exit for
bPass = True
Exit For
End If
Next
If Not(bPass) Then
oBag.AddValue "ErrorString", "'The DC " & sDCName & " is currently advertising but failed a Bind request! '" & vbcrlf
Err.Clear
bMonitorPass = False
Else
' If bind to LDAP succeeded we will then also check if we can bind to GC if the DC is GC
If oDCRootDSE.Get("isGlobalCatalogReady") Then
For i = 1 To iRetryCount
Err.Clear
Set oDCGCRootDSE = GetObject("GC://" & sDCName & "/RootDSE")
If 0 <> Err Then
bPass = False
oAPI.LogScriptEvent "DomainControllerHealthVerifier.vbs", 103, 2, "GC Bind Failure: " & Err.Description
Err.Clear
Else
' DC Bind succeeded, set bPass to true, and exit for
bPass = True
Exit For
End If
Next
End If
If Not(bPass) Then
oBag.AddValue "ErrorString", "'The DC " & sDCName & " is currently advertising as a GC but failed a Bind request to the GC!'" & vbcrlf
Err.Clear
bMonitorPass = False
End If
End If
End If
End If
oDCList.MoveNext
Loop
If bMonitorPass Then
oBag.AddValue "State", "GOOD"
Else
oBag.AddValue "State", "BAD"
End If
'******************************************************************************
Function PingServer( sServerName )
' Purpose: This function returns True if the specified host could be pinged.
' Parameters: sServerName, can be a computer name or IP address.
'
Dim oPingResults, oResult, sQuery
' Define the WMI query
sQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & sServerName & "'"
' Run the WMI query
Set oPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery( sQuery )
' Based on results return either True or False
For Each oResult In oPingResults
If Not IsObject( oResult ) Then
PingServer = False
ElseIf oResult.StatusCode = 0 Then
PingServer = True
Else
PingServer = False
End If
Next
End Function
'******************************************************************************
Function CheckSysvol( sServerName )
' Purpose: This function returns True if the sysvol is available.
' Parameters: sServerName, can be a computer name.
'
Dim oFSO
Dim bOut
bOut = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim sTest
sTest = "\\" & sServerName & "\sysvol"
If (oFSO.FolderExists(sTest)) Then
bOut = True
End If
CheckSysvol = bOut
End Function
'******************************************************************************
Sub HandleError(oErr,sErrorText)
'
' Purpose: If an Error is found this function handles it and updates
' The property bag appropriately
'
' Parameters: oErr, the error object
' sErrorText, Description of the task that produced the error
'
'
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "'" & sErrorText & "'." & GetErrorString(oErr)
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
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
HUN 
Show References: