Reguła Przeniesienie serwera usługi AD między lokacjami

AD_Server_Moved_Site (Rule)

Knowledge Base article:

Podsumowanie

Reguła przeniesienia serwera usługi AD między lokacjami. Ta reguła sprawdza, czy kontroler domeny został przeniesiony między lokacjami od czasu ostatniego uruchomienia tego skryptu. Możesz wyłączyć tę regułę, jeśli nie potrzebujesz wiedzieć, kiedy kontroler domeny zmienia swoją lokację.

Element properties:

TargetMicrosoft.Windows.Server.2008.AD.DomainControllerRole
CategoryMaintenance
EnabledTrue
Alert GenerateFalse
RemotableFalse

Member Modules:

ID Module Type TypeId RunAs 
Scheduler DataSource System.SimpleScheduler Default
WA WriteAction Microsoft.Windows.ScriptWriteAction Default

Source Code:

<Rule ID="AD_Server_Moved_Site" Enabled="onStandardMonitoring" Target="AD2008Core!Microsoft.Windows.Server.2008.AD.DomainControllerRole" ConfirmDelivery="false" Remotable="false" Priority="Normal" DiscardLevel="100">
<Category>Maintenance</Category>
<DataSources>
<DataSource ID="Scheduler" TypeID="System!System.SimpleScheduler">
<IntervalSeconds>86400</IntervalSeconds>
<SyncTime>00:01</SyncTime>
</DataSource>
</DataSources>
<WriteActions>
<WriteAction ID="WA" TypeID="Windows!Microsoft.Windows.ScriptWriteAction">
<ScriptName>AD_Server_Moved_Site.vbs</ScriptName>
<Arguments>$Target/Host/Property[Type="Windows!Microsoft.Windows.Computer"]/NetworkName$ $Target/Host/Property[Type="Windows!Microsoft.Windows.Computer"]/NetbiosComputerName$ false $Target/ManagementGroup/Id$</Arguments>
<ScriptBody><Script>
'*************************************************************************
' Script Name - AD Server Changed Site
'
' Purpose - Checks to see if the server has changed sites.
'
' Assumptions - Script is run by a timed event
'
' Parameters - LogSuccessEvent - Whether to log an event when the script
' completes successfully
'
' (c) Copyright 2001, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************

Option Explicit

'Event Constants
Const EVENT_TYPE_SUCCESS = 0
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4

'Other constants
Const SCRIPT_NAME = "AD Server Changed Site"

Dim oParams, oReg, oAPI
Set oAPI = CreateObject("Mom.ScriptAPI")
oReg=null
Err.Clear

Set oParams = WScript.Arguments
if oParams.Count &lt; 4 then
Wscript.Quit -1
End if


Dim sStateValuePath
sStateValuePath= "HKLM\" &amp; oAPI.GetScriptStateKeyPath(oParams(3))


' Registry Path to share data across scripts
Dim REG_Key
REG_Key = sStateValuePath &amp; "\AD Server Changed Site"

Const EVENTID_SERVER_CHANGED_SITES = 36
Const EVENTID_COULD_NOT_FIND_OBJECT = 2001
Const EVENTID_EVENT_RULE_ONLY = 2
Const EVENTID_SCRIPT_ERROR = 1000
Const EVENTID_SUCCESS = 99
Const EVENT_ID_AGENTLESS = 98


Sub Main()
On Error Resume Next
Dim IsTargetAgentless, bLogSuccessEvent, dtStart, TargetFQDNComputer, TargetNetbiosComputer

IsTargetAgentless = False
Err.Clear
IsTargetAgentless=false
If Not(IsTargetAgentless) Then
dtStart = Now
TargetFQDNComputer = oParams(0)
TargetNetbiosComputer = oParams(1)
bLogSuccessEvent = CBool(oParams(2))

Dim strStoredSiteGUID
strStoredSiteGUID = GetData("Site GUID")

Dim strComputer
strComputer = TargetFQDNComputer

Dim oRootDSE
Set oRootDSE = GetObject("LDAP://" &amp; strComputer &amp; "/RootDSE")

If 0 = Err.Number Then
Dim strConfigDN
strConfigDN = oRootDSE.Get("configurationNamingContext")

Dim oADOConn
Set oADOConn = CreateObject("ADODB.Connection")
oADOConn.Provider = "ADSDsOObject"
oADOConn.Open "ADs Provider"

Dim rsServers
Set rsServers = oADOConn.Execute("&lt;LDAP://" &amp; strComputer &amp; "/CN=Sites," &amp; strConfigDN &amp; "&gt;;(cn=" &amp; TargetNetbiosComputer &amp; ");adspath;subtree")

If 0 = Err.Number Then
' Bind to the computer then get it's parent (should be serversContainer) then
' bind to the parent of that object which will be the site.
Dim oComputer
Do Until rsServers.EOF Or IsObject(oComputer)
Set oComputer = GetObject(rsServers.Fields("adspath"))

rsServers.MoveNext
Loop

Set rsServers = nothing

Dim oSite
If IsObject(oComputer) Then

Dim oServersContainer

Set oServersContainer = GetObject(oComputer.Parent)
If IsObject(oServersContainer) Then
Set oSite = GetObject(oServersContainer.Parent)
End If

Set oServersContainer = nothing
Else
CreateEvent EVENTID_COULD_NOT_FIND_OBJECT, EVENT_TYPE_WARNING, "The script '" &amp; SCRIPT_NAME &amp; "' could not find " &amp; _
strComputer &amp; " in Active Directory."
bLogSuccess = False
End If

Set oComputer = nothing

Dim strSiteGUID
If IsObject(oSite) Then
' Get the objectGUID from the site.
strSiteGUID = oSite.GUID

Else
CreateEvent EVENTID_COULD_NOT_FIND_OBJECT, EVENT_TYPE_WARNING, "The script '" &amp; SCRIPT_NAME &amp; "' could not find the "&amp; _
"site containing " &amp; strComputer &amp; " in Active Directory."
bLogSuccess = False
End If

' If the stored value is not empty then compare with the siteGUID. If they are different
' then create an informational event and store the new guid.
If Len(strSiteGUID) &gt; 0 Then
If Len(strStoredSiteGUID) &gt; 0 Then
If Trim(LCase(strSiteGUID)) &lt;&gt; Trim(LCase(strStoredSiteGUID)) Then
' Find the name of the original site
Dim rsSites
Set rsSites = oADOConn.Execute("&lt;LDAP://" &amp; strComputer &amp; "/CN=Sites, " &amp; strConfigDN &amp; "&gt;;(objectCategory=Site);cn,adspath;subtree")

Dim strOriginalSite
strOriginalSite = "Original Site has been deleted"
Dim oTempSite
Do Until rsSites.EOF
Set oTempSite = GetObject(rsSites.Fields("adspath"))
If 0 = Err.Number Then
If oTempSite.GUID = strStoredSiteGUID Then
strOriginalSite = rsSites.Fields("cn")
End If
End If

rsSites.MoveNext
Loop

Set rsSites = nothing

CreateEvent EVENTID_SERVER_CHANGED_SITES, EVENT_TYPE_INFORMATION, "The server (" &amp; strComputer &amp; ") has changed sites." &amp; vbCrLf &amp; _
"Original Site : " &amp; strOriginalSite &amp; vbCrLf &amp; _
"Current Site : " &amp; oSite.Get("cn")
bLogSuccessEvent = False
End If
End If

SetData "Site GUID", strSiteGUID
End If

Set oSite = nothing
Else ' oADOConn.Execute(...)
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" &amp; SCRIPT_NAME &amp; "', failed to execute the following query:" &amp; vbCrLf &amp; _
"&lt;LDAP://" &amp; strComputer &amp; "/CN=Sites," &amp; strConfigDN &amp; "&gt;;(cn=" &amp; TargetNetbiosComputer &amp; ");adspath;subtree" &amp; _
vbCrLf &amp; GetErrorString(Err)
bLogSuccess = False
End If
Else ' GetObject("LDAP://" &amp; strComputer &amp; "/RootDSE")
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" &amp; SCRIPT_NAME &amp; "' failed to bind to the RootDSE of " &amp; _
strComputer &amp; "." &amp; vbCrLf &amp; GetErrorString(Err)
bLogSuccess = False
End If

If bLogSuccessEvent THen
CreateEvent EVENTID_SUCCESS, EVENT_TYPE_INFORMATION, "The script '" &amp; SCRIPT_NAME &amp; "' completed " &amp; _
"successfully in " &amp; DateDiff("s", Now, dtStart) &amp; " seconds."
End If
Else
CreateEvent EVENT_ID_AGENTLESS, EVENT_TYPE_ERROR, "The AD Management Pack does not support the agentless management mode." &amp; vbCrLf &amp; _
"The script '" &amp; SCRIPT_NAME &amp; "' will not execute." &amp; vbCrLf &amp; _
"To prevent this alert being generated again, either change the monitoring " &amp; _
"mode of the computer '" &amp; TargetFQDNComputer &amp; "' to agent-managed " &amp; _
"or disable the rule that generated this alert."
End If
End Sub

'******************************************************************************
' Name: CreateEvent
'
' 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
'
' Returns: None
'
Sub CreateEvent(lngEventID, lngEventType, strMessage)
On Error Resume Next
oAPI.LogScriptEvent "AD Server Changed Site", lngEventID, lngEventType, strMessage
End Sub

'******************************************************************************
Function GetData(strKey)
'
' Purpose: Retrieves data out of a varset. Uses the key to determine what
' data to retrieve.
'
' Arguments: strKey, the key of the data to retrieve
'
' Returns: String, the data to return or an empty string
'
On Error Resume Next
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Dim regData
regData = oReg.RegRead(REG_Key &amp; "\" &amp; strKey )
If IsNull(regData) or IsEmpty(regData) or regData = "" Then
GetData = ""
Else
GetData = regData
End If
Err.Clear
End Function

'******************************************************************************
Sub SetData(strKey, strData)
'
' Purpose: To store data in a varset. If the key exists then the data
' associated with that key is replaced, otherwise the key/data
' combination is added to the varset.
'
' Arguments: strKey, the key of the line to replace
' strData, the data to associate with the key
'
' Returns: Nothing
'
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Call oReg.RegWrite(REG_Key &amp; "\" &amp; strKey , strData )
Err.Clear
End Sub

'******************************************************************************
' Name: IsServiceRunning
'
' Purpose: To determine whether a given service is running
'
' Arguments: strServiceName, the name of the service that is to be checked
'
' Returns: Boolean, True if the service is in the running state.
'
Function IsServiceRunning(strServiceName)
On Error Resume Next

Dim objServiceSet
Dim objService
Dim strQuery

IsServiceRunning = False

'Get the status of Service
strQuery = "select * from Win32_Service where Name='" &amp; strServiceName &amp; "' and State='Running'"

Set objServiceSet = GetObject("winmgmts:").ExecQuery(strQuery)
If Err = 0 Then
For Each objService In objServiceSet
IsServiceRunning = True
Next
Else
' Must cancel the error handling before raising an exception
On Error Goto 0

Err.Raise Err.number, Err.Source, "While executing '" &amp; strQuery &amp; _
"', the following error occurred:" &amp; vbCrLf &amp; GetErrorString(Err)
End If
End Function

'******************************************************************************
' Name: GetErrorString
'
' Purpose: Attempts to find the description for an error if no description
' is passed in.
'
' Parameters: oError - the error object
'
' Return: String, the description for the error. (Includes the error code.)
'
Function GetErrorString(oError)
Dim lErrNumber, strErrDescription
lErrNumber = oError.Number
strErrDescription = oError.Description
On Error Resume Next
If 0 &gt;= Len(strErrDescription) 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 = &amp;HFFFF0000
Const HiWord8007 = &amp;H80070000
Const LoWordMask = 65535 ' This is equivalent to 0x0000FFFF

If (lErrNumber And ErrorMask) = HiWord8007 Then
Dim oShell
Set oShell = CreateObject("WScript.Shell")
If IsObject(oShell) Then
Dim oExec
Set oExec = oShell.Exec("net helpmsg " &amp; (lErrNumber And LoWordMask))

Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i &lt; 5)

strErrDescription = strMessage
End If
End If
End If

GetErrorString = "The error returned was '" &amp; strErrDescription &amp; "' (0x" &amp; Hex(lErrNumber) &amp; ")"
End Function

Call Main()

</Script></ScriptBody>
<TimeoutSeconds>300</TimeoutSeconds>
</WriteAction>
</WriteActions>
</Rule>