<DataSourceModuleType ID="Microsoft.Windows.Server.2012.R2.AD.Configuration.ReplicationPartnerCount.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="ConnectionsThresholdWarning" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" Selector="$Config/IntervalSeconds$" ParameterType="int"/>
<OverrideableParameter ID="ConnectionsThresholdWarning" Selector="$Config/ConnectionsThresholdWarning$" 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/ConnectionsThresholdWarning$ $Target/Property[Type="AD2012R2Core!Microsoft.Windows.Server.2012.R2.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.
'
' (c) Copyright 2014, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Option Explicit
SetLocale("en-us")
Sub Main()
Dim oAPI, oParams, oBag, oNTInfo, sError, sComputerName, oRoot
Dim lWarningThreshold, bIsRODC
Dim iOutboundConnections, bInterSiteConnectionExists
Dim oADO, strQuery, strConfigurationPath, strServerName
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
set oNTInfo = CreateObject("WinNTSystemInfo")
sComputerName = oNTInfo.ComputerName
On Error Resume Next
Err.Clear
Set oADO = CreateObject("ADODB.Connection")
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to create ADODB Connection." & GetErrorString(Err)
set oRoot = GetObject("LDAP://RootDSE")
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to contact Root DSE." & GetErrorString(Err)
' 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://" & sComputerName & "/CN=Sites," & strConfigurationPath & ">;(objectClass=server);cn;subtree"
iServers = ExecuteQueryAndCountRows(oADO, strQuery)
If iServers < 2 Then
oBag.AddValue "State", "GOOD"
oAPI.AddItem oBag
Call oAPI.Return(oBag)
Exit Sub
End If
' Search for outbound connections. (Which exist as inbound connections on other servers.)
strQuery = "<LDAP://" & sComputerName & "/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://" & sComputerName & "/CN=Sites," & strConfigurationPath & ">;(objectClass=site);cn;onelevel"
iSites = ExecuteQueryAndCountRows(oADO, strQuery)
If iSites > 1 Then
' Multiple sites exist. Ensure that there is at least one inbound connection from another site.
strQuery = "<LDAP://" & sComputerName & "/CN=Sites," & strConfigurationPath & ">;" & _
"(&(objectCategory=nTDSConnection)" & _
"(!fromServer=CN=NTDS Settings," & strServerName & ")" & _
"(|(!(Name=*DEL*))(!(Name=*CNF*)))" & _
");cn;subtree"
Set rsConnections = oADO.Execute(strQuery)
bInterSiteConnectionExists = Not(rsConnections.EOF)
Else
bInterSiteConnectionExists = True
End If
sError = ""
' If necessary, construct messages to notify the user of possible replication problems.
If ((iOutboundConnections = 0) And Not(bIsRODC)) Then
sError = "The server has no outbound connections to any other server in this domain." & vbCrLf
End If
If Not (bInterSiteConnectionExists) Then
sError = sError & "The server exists in a replication site island." & vbCrLf
End If
' If appropriate, warn the user of excessive connections
If iOutboundConnections > lWarningThreshold Then
sError = sError & "The server has " & CStr(iOutboundConnections) & " outbound replication connection(s) which is more than the specified threshold of " & _
lWarningThreshold & " connection(s)." & vbCrLf
End If
If sError <> "" then
oBag.AddValue "State", "WARN"
oBag.AddValue "ErrorString", "One or more AD Replication Partner verifications have failed." & vbCrLf & sError
oAPI.AddItem oBag
Else
oBag.AddValue "State", "GOOD"
oAPI.AddItem oBag
End If
oAPI.ReturnItems
End Sub
'******************************************************************************
Function ExecuteQueryAndCountRows(oADO, strQuery)
'
' Purpose: Executes the given query and counts the number of returned rows.
'
' Arguments: oADO, 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 = oADO.Execute(strQuery)
ExecuteQueryAndCountRows = rsQuery.RecordCount
' Release the recordset
Set rsQuery = nothing
End Function
'******************************************************************************
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 sError, i
Do
sError = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(sError) = 0) And (i < 5)
strErr = sError
End If
End If
End If
GetErrorString = vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
Home
ENU 
Show References: