<DataSourceModuleType ID="AD_Replication_Partner_Count.DataSource" Accessibility="Internal" Batching="false">
<Configuration>
<xsd:element name="IntervalSeconds" type="xsd:int"/>
<xsd:element name="TargetComputerName" type="xsd:string"/>
<xsd:element name="LogSuccessEvent" type="xsd:boolean"/>
<xsd:element name="ConnectionsThresholdWarning" type="xsd:string"/>
<xsd:element name="ConnectionsThresholdError" 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="ConnectionsThresholdWarning" Selector="$Config/ConnectionsThresholdWarning$" ParameterType="string"/>
<OverrideableParameter ID="ConnectionsThresholdError" Selector="$Config/ConnectionsThresholdError$" 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_Replication_Partner_Count.vbs$ $Config/TargetComputerName$ $Config/LogSuccessEvent$ $Config/ConnectionsThresholdWarning$ $Config/ConnectionsThresholdError$ $Target/Property[Type="AD2008Core!Microsoft.Windows.Server.2008.AD.DomainControllerRole"]/IsRODC$ </CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>AD_Replication_Partner_Count.vbs</Name>
<Contents><Script>
'*************************************************************************
' Script Name - AD Replication Partner Count
'
' Purpose - Checks to make sure a DC is not on a replication island,
' and that the number of inbound and outbound connections
' are within reasonable limits.
'
' Assumptions - Script is run by a timed event
'
' Parameters - LogSuccessEvent - Indicates whether to log an event when
' the script completes successfully (that is without
' logging any errors)
' ConnectionsThresholdWarning - If the number of connections
' (either inbound or outbound) is greater than this
' number then an alert, of severity warning, is raised.
' ConnectionsThresholdError - If the number of connections
' (either inbound or outbound) is greater than this
' number then an alert, of severity error, is raised.
'
' (c) Copyright 2001, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
' Limits, as defined by the Active Directory Best practices.
' The MAX_CONNECTIONS constant is defined as 1175 because Active Directory triggers Warning event ID=1870 if a Domain Controller has more than 1175 replication partners.
Const MAX_CONNECTIONS = 1175
Const MIN_CONNECTIONS = 1
Dim oAPI, oParams, oBag, oReg
Set oAPI = CreateObject("Mom.ScriptAPI")
oReg=null
Err.Clear
Dim bAddItem, nState
bAddItem=true
nState=0
Sub Main()
On Error Resume Next
Dim iOutboundConnections
Dim bInterSiteConnectionExists
' Other Variables
Dim dtStart, lWarningThreshold, lErrorThreshold, strInvalidParams, TargetFQDNComputer, bLogSuccess, IsTargetAgentless, bIsRODC
Set oParams = WScript.Arguments
if oParams.Count < 5 Then
Wscript.Echo "Incorrect number of arguments!"
Wscript.Quit -1
End if
If (MIN_CONNECTIONS > lWarningThreshold) Or (MAX_CONNECTIONS < lWarningThreshold) Then
strInvalidParams = strInvalidParams & "ConnectionsThresholdWarning must be between " & MIN_CONNECTIONS & " and " & MAX_CONNECTIONS & "." & vbCrLf & _
"The current value of ConnectionsThresholdWarning is " & _
lWarningThreshold & "." & vbCrLf & _
"ConnectionsThresholdWarning will be set to 20 for " & _
"this execution of this script." & vbCrLf
lWarningThreshold = 20
End If
If (lErrorThreshold < lWarningThreshold) Then
strInvalidParams = strInvalidParams & "ConnectionsThresholdError must not be less than " & _
"ConnectionsThresholdWarning." & vbCrLf & _
"The current value of ConnectionsThresholdError is " & _
lErrorThreshold & "." & vbCrLf & _
"The current value of ConnectionsThresholdWarning is " & _
lWarningThreshold & "." & vbCrLf & _
"ConnectionsThresholdError will be set to " & lWarningThreshold & _
" for this execution of this script." & vbCrLf
lErrorThreshold = lWarningThreshold
End If
If (MIN_CONNECTIONS > lErrorThreshold) Or (MAX_CONNECTIONS < lErrorThreshold) Then
Dim lOriginalThreshold
lOriginalThreshold = lErrorThreshold
If lWarningThreshold > 30 Then
lErrorThreshold = lWarningThreshold
Else
lErrorThreshold = 30
End If
strInvalidParams = strInvalidParams & "ConnectionsThresholdError must be between " & MIN_CONNECTIONS & " and " & MAX_CONNECTIONS & "." & vbCrLf & _
"The current value of ConnectionsThresholdError is " & _
lOriginalThreshold & "." & vbCrLf & _
"ConnectionsThresholdError will be set to " & lErrorThreshold & _
" for this execution of this script." & vbCrLf
End If
If 0 < Len(strInvalidParams) Then
bAddItem=false
CreateEvent EVENT_ID_INVALID_PARAMETER, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & _
"' detected one or more invalid parameters." & _
vbCrLf & vbCrLf & strInvalidParams & 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 If
Dim ADOConnection, strQuery
Dim strComputerName, strConfigurationPath, strServerName
strComputerName = TargetFQDNComputer
Initialize strComputerName, ADOConnection, strConfigurationPath, strServerName
If 0 <> Err Then
bAddItem=false
ScriptError "failed to initialize correctly." & GetErrorString(Err)
Else
' Bind to this computer in AD
Dim oComputer
BindObject "LDAP://" & strComputerName & "/" & strServerName, oComputer
If 0 <> Err Then
bAddItem=false
ScriptError "failed to bind to 'LDAP://" & strComputerName & "/" & strServerName & "'." & GetErrorString(Err)
Else
' Check to see if multiple servers exist. If there is only a single server then
' don't run the test as it can't have any replicas.
strQuery = "<LDAP://" & strComputerName & "/CN=Sites," & strConfigurationPath & ">;(objectCategory=server);cn;subtree"
Dim iServers
iServers = ExecuteQueryAndCountRows(ADOConnection, strQuery)
Dim bLoneServer
If iServers < 2 Then
bLoneServer = True
End If
If Not(bLoneServer) Then
' Search for outbound connections. (Which exist as inbound connections on other servers.)
strQuery = "<LDAP://" & strComputerName & "/CN=Sites," & strConfigurationPath & ">;" & _
"(&(objectCategory=nTDSConnection)" & _
"(fromServer=CN=NTDS Settings," & strServerName & ")" & _
"(|(!(Name=*DEL*))(!(Name=*CNF*)))" & _
");cn;subtree"
' Check to see if there are multiple sites. If there are then make sure
' that this site has an inbound connection from another one.
strQuery = "<LDAP://" & strComputerName & "/CN=Sites," & strConfigurationPath & ">;(objectCategory=siteObject);cn;onelevel"
Dim iSites
iSites = ExecuteQueryAndCountRows(ADOConnection, strQuery)
If iSites > 1 Then
' Multiple sites exist. Ensure that there is at least one inbound connection
' from another site.
' Get this servers parent (which is this site.)
Dim oSite
Set oSite = GetObject(oComputer.Parent)
' Construct a query which will look for all inbound connections to this site,
' excluding all connections FROM this site.
strQuery = "<LDAP://" & strComputerName & "/CN=" & oSite.Name & ",CN=Sites," & strConfigurationPath & ">;(&(objectCategory=connectionObject)"
Dim oServer
For Each oServer In oSite
strQuery = strQuery & "(fromServer<>" & oServer.distinguishedName & ")"
Next
strQuery = strQuery & ");cn;subtree"
Dim rsConnections
Set rsConnections = ADOConnection.Execute(strQuery)
bInterSiteConnectionExists = Not(rsConnections.EOF)
Else
bInterSiteConnectionExists = True
End If
End If
' If necessary, construct messages to notify the user of possible replication problems.
Dim strMessage
If Not(bLoneServer) AND (((iOutboundConnections = 0) And Not(bIsRODC)) Or Not (bInterSiteConnectionExists)) Then
strMessage = strMessage & "The server, '" & strComputerName & "' " & vbCrLf
Dim strJoin
strJoin = ""
If (iOutboundConnections = 0) And Not(bIsRODC) Then
strMessage = strMessage & " has no outbound connections to any other server in this domain"
strJoin = " and " & vbCrLf
End If
If Not(bInterSiteConnectionExists) Then
strMessage = strMessage & strJoin & " exists in a replication site island"
End If
strMessage = strMessage & "."
CreateEvent EVENT_ID_REPLICATION_ISLAND, EVENT_TYPE_WARNING, strMessage
bLogSuccess = False
End If
' If appropriate, warn the user of excessive connections
strMessage = "The server, '" & strComputerName & "' " & vbCrLf
If iOutboundConnections > lWarningThreshold Then
strMessage = strMessage & "has " & CStr(iOutboundConnections) & " outbound replication connections, which is more than the recommended number (" & _
lWarningThreshold & ")" & vbCrLf
End If
If (iOutboundConnections > lWarningThreshold) Then
If (iOutboundConnections < lErrorThreshold) Then
CreateEvent EVENT_ID_TOO_MANY_CONNECTIONS, EVENT_TYPE_WARNING, strMessage
Else
CreateEvent EVENT_ID_TOO_MANY_CONNECTIONS, EVENT_TYPE_ERROR, strMessage
End If
bLogSuccess = False
End If
If bLogSuccess Then
If bLoneServer Then
strMessage = "The server, " & strComputerName & ", is the only server in this domain." & vbCrLf
Else
strMessage = ""
End If
strMessage = strMessage & "The script '" & SCRIPT_NAME & "' completed successfully in " & _
DateDiff("s", dtStart, Now) & " seconds."
CreateEvent EVENT_ID_SUCCESS, EVENT_TYPE_INFORMATION, strMessage
End If
End If
End If
if bAddItem=true then
if nState=1 then
set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "FAILED"
oBag.AddValue "EventID", EVENT_ID_FAILED
oAPI.AddItem oBag
END IF
if nState=2 then
set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "WARNING"
oBag.AddValue "EventID", EVENT_ID_WARNING
oAPI.AddItem oBag
END IF
if nState=0 then
set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "SUCCESS"
oBag.AddValue "EventID", EVENT_ID_SUCCEEDED
oAPI.AddItem oBag
END IF
end if
oAPI.ReturnItems
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
End Sub
'******************************************************************************
Sub CreateEvent(lngEventID, lngEventType, strMessage)
'
' Purpose: To create a MOM event
'
' Arguments: lngEventID, the event ID
' lngEventType, the event type (see values at top of file)
' strMessage, the message text for the event
if lngEventID=EVENT_ID_TOO_MANY_CONNECTIONS and lngEventType=EVENT_TYPE_ERROR then
nState=1
end if
if lngEventID=EVENT_ID_TOO_MANY_CONNECTIONS and lngEventType=EVENT_TYPE_WARNING then
if nState<>1 then
nState=2
end if
end if
if lngEventID=EVENT_ID_REPLICATION_ISLAND and nState <> 1 then
nState=2
end if
End Sub
'******************************************************************************
Sub BindObject(strBindPath, ByRef oOutput)
'
' Purpose: To bind to an object with error tolerance, throw an error if
' one occurs
'
' Arguments: strBindPath, the path of the object to bind to
' oOutput, the variable to hold the object once it
' has been bound to.
'
Dim oInternalObject
On Error Resume Next
Set oInternalObject = GetObject(strBindPath)
If Err.Number = 0 Then
Set oOutput = oInternalObject
Else
oOutput = nothing
Err.Raise Err.Number
End If
Set oInternalObject = nothing
End Sub
'******************************************************************************
Function Initialize(strComputerName, ByRef ADOConnection, ByRef strConfigurationPath, ByRef strServerName)
'
' Purpose: Initialize the base objects required by the rest of the script.
'
' Arguments: ADOConnection, object to store the new ADODB.Connection in
' strComputerName, stores the DNS name of the computer in
' strConfigurationPath, stores the configurationNamingContext in
' strServerName, stores the name of the server in
'
' Returns: True or False, True if initialization was successful
'
Initialize = False
' Setup an ADO connection
On Error Resume Next
Set ADOConnection = CreateObject("ADODB.Connection")
If Err.Number = 0 Then
ADOConnection.Provider = "ADSDsOObject"
ADOConnection.Open "ADs Provider"
If Err.Number = 0 Then
' Bind to the rootDSE to get the naming contexts
Dim oRootDSE
BindObject "LDAP://" & strComputerName & "/RootDSE", oRootDSE
If 0 <> Err Then
Set ADOConnection = nothing
If (Len(strConfigurationPath) = 0) Or (Len(strServerName) = 0) Then
Set ADOConnection = nothing
Err.Raise &H80000000, "Invalid initialization detected:" & vbCrLf & _
"ConfigurationPath = " & strConfigurationPath & ", ServerName = " & strServerName
Else
Initialize = True
End If
End If
Else
Err.Raise Err.Number
End If
End Function
'******************************************************************************
Function ExecuteQueryAndCountRows(ADOConnection, strQuery)
'
' Purpose: Executes the given query and counts the number of returned rows.
'
' Arguments: ADOConnection, the connection on which to execute the query
' strQuery, the query to execute
'
' Returns: The number of rows returned by the query. (0 if an error occurs)
'
Dim rsQuery
Set rsQuery = ADOConnection.Execute(strQuery)
ExecuteQueryAndCountRows = rsQuery.RecordCount
' Release the recordset
Set rsQuery = nothing
End Function
'******************************************************************************
Sub ScriptError(strError)
'
' Purpose: Records a script error.
'
' Parameters: strError, the description of the error to record
'
CreateEvent EVENT_ID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' " & 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
Home
ITA 
Show References: