' Registry Path to share data across scripts
Dim sStateValuePath, REG_Key
Dim oAPI, oParams, oBag, bErrorsExceededThreshold, bErrorWasFound, intFailureThreshold
Dim oADOConn
Dim bLogSuccessEvent
Dim strConfig, strDomain, strSchema, TargetFQDNComputer, oReg
bErrorsExceededThreshold = false
bErrorWasFound = false
oReg = Null
Set oAPI = CreateObject("Mom.ScriptAPI")
Err.Clear
Sub Main()
On Error Resume Next
Dim objAD, objPartner, objDC, oRootDSE
Dim dtStart
Dim strMessage, strComputer, strDC, strDnsDC, strAdsPath
Dim strSourceDomain, strPartnerDomain
Dim bCheckNextOperationMasterOnReplica
' Other Variables
Dim IsTargetAgentless
' Variables required to compute and keep track of the Failure Threshold
Dim strManagementGroupName
Set oParams = WScript.Arguments
if oParams.Count < 4 then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_INFRASTRUCTURE_ERROR, "The script '" & SCRIPT_NAME & _
"' failed to execute. Incorrect number of arguments"
Exit Sub
End if
CreateDebugEvent EVENT_ID_DISCOVERY_INFO, _
vbCrLf & _
"Monitoring script has been invoked with arguments:" & vbCrLf & _
"TargetFQDNComputer= " & TargetFQDNComputer & vbCrLf & _
"bLogSuccessEvent= " & bLogSuccessEvent & vbCrLf & _
"intFailureThreshold= " & intFailureThreshold & vbCrLf & _
"strManagementGroupName= " & strManagementGroupName
sStateValuePath= "HKLM\" & oAPI.GetScriptStateKeyPath(strManagementGroupName)
REG_Key = sStateValuePath & "\AD Management Pack\" & SCRIPT_NAME
CreateDebugEvent EVENT_ID_DISCOVERY_INFO, "Operation Master consistency failure count will be tracked in the registry key: " & REG_Key
' If the ComputerName passed in is in an FQDN format, cut it down to just the computer name
Dim nInStr
nInStr = InStr(TargetFQDNComputer, ".")
If 0 <> nInStr Then
TargetFQDNComputer = Left(TargetFQDNComputer, nInStr-1)
End If
Set oADOConn = CreateObject("ADODB.Connection")
If Err <> 0 Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_INFRASTRUCTURE_ERROR, "The script '" & SCRIPT_NAME & "' could not create object " & _
"'ADODB.Connection'. This is an unexpected error." & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
Exit Sub
End If
oADOConn.Provider = "ADSDsOObject"
oADOConn.Open "ADs Provider"
If Err <> 0 Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_INFRASTRUCTURE_ERROR, "The script '" & SCRIPT_NAME & "' could not connect to the " & _
"object 'ADODB.Connection'. This is an unexpected error." & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
Exit Sub
End If
If Not(IsTargetAgentless) Then
dtStart = Now
strComputer = TargetFQDNComputer
Set objAD = CreateObject("McActiveDir.ActiveDirectory")
If (0 <> Err.Number) Or (Not(IsObject(objAD))) Then
Dim errorString
errorString = "The script '" & SCRIPT_NAME & "' failed to create object " & _
"'McActiveDir.ActiveDirectory'. This is an unexpected error." & vbCrLf & vbCrLf & _
GetErrorString(Err.Number, Err.Description) & vbCrLf & vbCrLf & _
"The Active Directory Management Pack Objects (OOMADs) components are not installed on the Domain Controller. These components are required for the monitoring scripts to run successfully. See Alert Knowledge for additional details."
On Error Resume Next
Set objDC = objAD.BindObject(strAdsPath)
If (0 <> Err.Number) Or (Not(IsObject(objDC))) Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' could not bind to '" & strAdsPath & _
"'. " & vbCrLf & GetErrorString(Err.Number, Err.Description)
Else
' The DNS name and DC hostname of the replication partner
strDnsDC = LCase(objDC.Get("dNSHostName"))
strDC = LCase(objDC.Get("cn"))
Set objDC = Nothing
If 0 <> Err Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' could not read required " & _
"fields from the object '" & strAdsPath & "'." & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
Exit Sub
End If
' Bind to the local DC, because that is where we want to look up the naming contexts
Set oRootDSE = GetObject("LDAP://localhost/RootDSE")
If 0 <> Err Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' could not reach " & _
"the RootDSE on the localhost." & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
Exit Sub
End If
' Get the naming contexts for config, domain, and schema
strConfig = oRootDSE.Get("ConfigurationNamingContext")
strDomain = oRootDSE.Get("DefaultNamingContext")
strSchema = oRootDSE.Get("SchemaNamingContext")
Set objPartner = CreateObject("McActiveDir.ActiveDirectory")
If (0 <> Err.Number) Or (Not(IsObject(objPartner))) Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_INFRASTRUCTURE_ERROR, "The script '" & SCRIPT_NAME & "' could not create object " & _
"'McActiveDir.ActiveDirectory'. This is an unexpected error." & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
Exit Sub
End If
objPartner.Server = strDC
strPartnerDomain = objPartner.GetDomainForDC(strDC)
If 0 <> Err Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' could not " & _
"determine the domain " & _
"for the DC '" & strDC & "'. " & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
Else
bCheckNextOperationMasterOnReplica = true
' We only want to validate the PDC, Infrastructure, RID, and DomainNaming masters if the remote machine is in the
' same domain as we are
If strPartnerDomain = strSourceDomain Then
' PDC
bCheckNextOperationMasterOnReplica = CBool(CheckFSMOHolder(PDC_FSMO, objAD, strDnsDC))
' RID Master
If bCheckNextOperationMasterOnReplica Then
bCheckNextOperationMasterOnReplica = CBool(CheckFSMOHolder(RID_FSMO, objAD, strDnsDC))
End If
' Infrastructure Master
If bCheckNextOperationMasterOnReplica Then
bCheckNextOperationMasterOnReplica = CBool(CheckFSMOHolder(INFRA_FSMO, objAD, strDnsDC))
End If
End If
' Schema Master
If bCheckNextOperationMasterOnReplica Then
bCheckNextOperationMasterOnReplica = CBool(CheckFSMOHolder(SCHEMA_FSMO, objAD, strDnsDC))
End If
' Domain Naming Master
If bCheckNextOperationMasterOnReplica Then
bCheckNextOperationMasterOnReplica = CBool(CheckFSMOHolder(DOM_NAME_FSMO, objAD, strDnsDC))
End If
Set objPartner = Nothing
Err.Clear
End If
End If
strAdsPath = objAD.NextReplicationPartner()
Wend
If bErrorsExceededThreshold = false Then
If bErrorWasFound = false Then
ResetConsecutiveErrorCount intFailureThreshold
End If
set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "GOOD"
oBag.AddValue "EventID", EVENTID_GOOD
oAPI.AddItem oBag
END If
CreateDebugEvent EVENTID_SUCCESS, "The script '" & SCRIPT_NAME & "' completed in " & DateDiff("s", dtStart, Now) & " seconds."
oAPI.ReturnItems
Else
strMessage = "An error occurred." & vbCrLf & _
"Error: Could not get list of replication partners."
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_INFRASTRUCTURE_ERROR, strMessage
End If
Set objAD = Nothing
Else
HandleScriptEvent EVENT_ID_AGENTLESS, EVENT_TYPE_INFRASTRUCTURE_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
'******************************************************************************
' Name: GetOpMaster
'
' Purpose: Get the Operational Master DNS name for a particular FSMO role by
' querying a specific DC
'
' Parameters: strDnsDC, The name of the DC to be queried
' strNC, The naming context to query
' strObjClass, The specific objectClass of the fSMORoleOwner
'
' Return: The DNS name of the DC holding the FSMO role
'
Function GetOpMaster(strDnsDC, strNC, strObjClass)
Dim strQuery, rsResult, oTemp, oPartner
On Error Resume Next
' Attempt to get the FSMO role owner by querying the remote machine
strQuery = "<LDAP://" & strDnsDC & "/" & strNC & ">;(&(objectClass=" & strObjClass & ")(fSMORoleOwner=*));fSMORoleOwner;Subtree"
Set rsResult = oADOConn.Execute(strQuery)
If 0 <> Err Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' failed to execute " & _
"the following LDAP query: '" & vbCrLf & vbCrLf & strQuery & "'. " & _
vbCrLf & vbCrLf & GetErrorString(Err.Number, Err.Description)
Set rsResult = Nothing
Exit Function
End If
rsResult.MoveFirst
' This will return the NTDS Settings object of the partner. Get the parent of the object, then look at the dNSHostName field
Set oTemp = GetObject("LDAP://" & strDnsDC & "/" & rsResult("fSMORoleOwner"))
If 0 <> Err Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' failed to get " & _
"the fSMORoleOwner for '" & strDnsDC & "'." & _
vbCrLf & vbCrLf & GetErrorString(Err.Number, Err.Description)
Set rsResult = Nothing
Exit Function
End If
Set oPartner = GetObject(oTemp.Parent)
If 0 <> Err Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' failed to get " & _
"the fSMORoleOwner parent object for '" & strDnsDC & "'." & _
vbCrLf & vbCrLf & GetErrorString(Err.Number, Err.Description)
Set rsResult = Nothing
Exit Function
End If
GetOpMaster = oPartner.Get("dNSHostName")
If 0 <> Err Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' failed to get " & _
"the dNSHostName for '" & strDnsDC & "'." & _
vbCrLf & vbCrLf & GetErrorString(Err.Number, Err.Description)
Set rsResult = Nothing
Exit Function
End If
Set rsResult = Nothing
End Function
'******************************************************************************
' Name: CheckFSMOHolder
'
' Purpose: Compares the specified FSMO holder on the local DC vs. the target DC.
'
' Parameters: fsmo, The fsmo role we are checking
' objAD, Initialized OOMADS object
' strDnsDC, The remote DC that we are comparing against
'
' Return: True - no errors encountered during operation execution and continue to next FSMO
' False - an error occurred during the operation and continue to next DC
'
Function CheckFSMOHolder(fsmo, objAD, strDnsDC)
Dim strMaster1, strMaster2, strMessage, strNC, fsmoGetOpMasterParam
Err.Clear
Select Case fsmo
Case PDC_FSMO
fsmoGetOpMasterParam = "domainDNS"
strNC = strDomain
strMaster1 = LCase(objAD.PDCMaster)
Case RID_FSMO
fsmoGetOpMasterParam = "rIDManager"
strNC = strDomain
strMaster1 = LCase(objAD.RIDMaster)
Case INFRA_FSMO
fsmoGetOpMasterParam = "infrastructureUpdate"
strNC = strDomain
strMaster1 = LCase(objAD.InfrastructureMaster)
Case SCHEMA_FSMO
fsmoGetOpMasterParam = "dMD"
strNC = strSchema
strMaster1 = LCase(objAD.SchemaMaster)
Case DOM_NAME_FSMO
fsmoGetOpMasterParam = "crossRefContainer"
strNC = strConfig
strMaster1 = LCase(objAD.DomainNamingMaster)
End Select
' The FSMO role owner according to the local DC
If 0 <> Err or strMaster1 = "" Then
HandleScriptEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' could not " & _
"determine the " & fsmo & _
" for the DC '" & TargetFQDNComputer & "'. " & _
vbCrLf & GetErrorString(Err.Number, Err.Description)
CheckFSMOHolder = false
Exit Function
End If
If strMaster2 = "" Then
' No event is created in this case. The GetOpMaster function is responsible for creating the event if any issues arise.
CheckFSMOHolder = false
Exit Function
End If
If strMaster1 <> strMaster2 Then
strMessage = "FSMO Inconsistency: " & fsmo & " is inconsistent with replication partner: " & strDnsDC & vbCrLf & _
"Expected FSMO owner: " & strMaster1 & vbCrLf & _
"FSMO owner according to replication partner: " & strMaster2
HandleScriptEvent EVENTID_OP_MASTERS_INCONSISTENT, EVENT_TYPE_WARNING, strMessage
CheckFSMOHolder = false
Exit Function
End If
' If we have reached this part of the code, there were no errors so we will log the success event and return true
strMessage = fsmo & " is consistent with replication partner: " & strDnsDC & vbCrLf & _
"Expected FSMO owner: " & strMaster1 & vbCrLf & _
"FSMO owner according to replication partner: " & strMaster2
CreateDebugEvent EVENTID_SUCCESS, strMessage
CheckFSMOHolder = true
End Function
'******************************************************************************
' Name: HandleScriptEvent
'
' Purpose: Creates a MOM event taking into consideration the Failure Threshold
'
' Parameters: lngEventID, the ID for the event
' lngEventType, the severity for the event. See constants at head of file
' strMessage, the message for the event
'
' Return: nothing
'
Sub HandleScriptEvent(lngEventID, lngEventType, strMessage)
On Error Resume Next
Dim lCurrentErrorCount,tmplConsecutiveErrors
Dim strErrorDescriptions, sameFailureIndex
If lngEventType <> EVENT_TYPE_INFRASTRUCTURE_ERROR Then
' The logic that handles the errors taking the failure threshold into consideration should not be triggered
' when the event is of EVENT_TYPE_UNEXPECTED_ERROR type
tmplConsecutiveErrors = GetData("ErrorCount")
If tmplConsecutiveErrors = "" Then
lCurrentErrorCount = 0
Else
lCurrentErrorCount = Clng(tmplConsecutiveErrors)
End If
lCurrentErrorCount = lCurrentErrorCount + 1
' An error has been found; set the bErrorWasFound = true to prevent the ResetConsecutiveErrorCount function from being called.
bErrorWasFound = true
' Compare the Failure that was previously saved on the Registry key to the new failure.
' If the new Failure is already contained on the Registry key, there is no need to save it again.
' This mitigates growth of the registry key's data.
sameFailureIndex = InStr(1, strErrorDescriptions, strMessage, vbTextCompare)
If sameFailureIndex = 0 or sameFailureIndex <> null Then
strErrorDescriptions = vbCrLf & strMessage & vbCrLf & strErrorDescriptions
Call SetData("ErrorDescriptions", strErrorDescriptions)
End If
SetData "ErrorCount", lCurrentErrorCount
Dim strAlertMessage
If lCurrentErrorCount <= intFailureThreshold Then
' We have registered a failure but we have not exceeded the Failure Threshold
' Generate an informational event detailing the errors that occurred but do not set the property bag to
' the BAD state
strAlertMessage = "While running '" & SCRIPT_NAME & "' the following consecutive FSMO role inconsistencies were encountered:" & _
vbCrLf & strErrorDescriptions & vbCrLf & _
"The FSMO consistency monitor is still considered healthy because the number of FSMO Role inconsistencies registered so far has not exceeded the configured threshold: " & intFailureThreshold & ". " & vbCrLf & _
"A event log entry from " & SCRIPT_NAME & " with ID = " & EVENT_ID_SUCCESS_AFTER_FAILURES & " will be generated when the script succeeds, with details of all the " & _
"errors that occurred."
oAPI.LogScriptEvent SCRIPT_NAME, EVENT_ID_DISCOVERY_INFO, EVENT_TYPE_WARNING, strAlertMessage
Else
' A failure has been registered and we have exceeded the configured threshold.
' The state will be set to "BAD" and set of errors that were recorded will be attached to the alert via the ErrorString attribute on the property bag
bErrorsExceededThreshold = true
strAlertMessage = "While running '" & SCRIPT_NAME & "' the following consecutive errors were encountered:" & vbCrLf & _
strErrorDescriptions & vbCrLf & _
"The number of FSMO Role inconsistencies registered so far has exceeded the configured threshold." & vbCrLf & _
"The FSMO Role inconsistency threshold (failure threshold) is " & intFailureThreshold
' We create an error event for the last message received (since it was the one that pushed us above the configured threshold; but we report all the errors
' that we have been tracking so far on the property bag, to make them available on the Alert Message generated by the monitor
oAPI.LogScriptEvent SCRIPT_NAME, lngEventID, lngEventType, strMessage
oAPI.ReturnItems
End If
Else
' Events of type EVENT_TYPE_INFRASTRUCTURE_ERROR should immediately trigger the "BAD" state.
' The Failure Threshold should only be used for expected errors.
' No need to set bErrorWasFound = true here. When bErrorsExceededThreshold = true, we automatically skip the call to ResetConsecutiveErrorCount
bErrorsExceededThreshold = true
oAPI.LogScriptEvent SCRIPT_NAME, lngEventID, EVENT_TYPE_ERROR, strMessage
'******************************************************************************
' Name: GetErrorString
'
' Purpose: Attempts to find the description for an error if no description
' is passed in.
'
' Parameters: lErrNumber, the error number
' strErrDescription, the error description (if known)
'
' Return: String, the description for the error. (Includes the error code.)
'
Function GetErrorString(lErrNumber, strErrDescription)
On Error Resume Next
If 0 >= 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 = &HFFFF0000
Const HiWord8007 = &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 " & (lErrNumber And LoWordMask))
Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i < 5)
strErrDescription = strMessage
End If
End If
End If
GetErrorString = "The error returned was '" & strErrDescription & "' (0x" & Hex(lErrNumber) & ")"
End Function
'******************************************************************************
' Name: ResetConsecutiveErrorCount
'
' Purpose: Resets the consecutive error count. Called when the script
' completes successfully.
'
' Parameters: lThreshold, the threshold for generating an alert from
' consecutive failures.
'
' Return: Nothing
'
Sub ResetConsecutiveErrorCount(lThreshold)
On Error Resume Next
Dim lConsecutiveErrors,tmplConsecutiveErrors
tmplConsecutiveErrors = GetData("ErrorCount")
if tmplConsecutiveErrors = "" Then
lConsecutiveErrors = 0
else
lConsecutiveErrors = Clng(tmplConsecutiveErrors)
end if
If lConsecutiveErrors > lThreshold Then
' We have succeeded after having raised an alert for this monitor. Create a
' success event.
Dim strErrorDescriptions
strErrorDescriptions = GetData ( "ErrorDescriptions")
oAPI.LogScriptEvent SCRIPT_NAME, EVENT_ID_SUCCESS_AFTER_FAILURES, EVENT_TYPE_INFORMATION, "The script '" & SCRIPT_NAME & "' has reported no FSMO inconsistencies following " & _
lConsecutiveErrors & " consecutive failures." & vbCrLf & _
"The errors reported were:" & vbCrLf & strErrorDescriptions
End If
SetData "ErrorCount", 0
SetData "ErrorDescriptions", ""
End Sub
'******************************************************************************
' Name: GetData
'
' Purpose: Retrieves data out of a varset. Uses the key to determine what
' data to retrieve.
'
' Parameters: strKey, the key of the data to retrieve
'
'
' Return: The contents of the registry key. An empty string is returned if the registry key
' does not exist or if it is empty
'
Function GetData(strKey)
On Error Resume Next
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Dim regData
regData = oReg.RegRead(REG_Key & "\" & strKey )
If IsNull(regData) or IsEmpty(regData) or regData = "" Then
GetData = ""
Else
GetData = regData
End If
Err.Clear
End Function
'******************************************************************************
' Name: SetData
'
' 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.
'
' Parameters: strKey, the key of the line to replace
' strData, the data to associate with the key
'
' Return: Nothing
'
Sub SetData(strKey, strData)
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Call oReg.RegWrite(REG_Key & "\" & strKey , strData )
Err.Clear
End Sub
'******************************************************************************
' Name: CreateDebugEvent
'
' Purpose: To create an informational event for Debugging purposes if bLogSuccessEvent is true
'
' Parameters: eid, an Integer containing the Event ID
' strMsg, a String with the Message to be associated to the event
'
' Return: Nothing
'
Sub CreateDebugEvent(ByVal eid, ByVal strMsg)
If bLogSuccessEvent Then
Call oAPI.LogScriptEvent(SCRIPT_NAME, eid, EVENT_TYPE_INFORMATION, strMsg)
End If
End Sub
Home
RUS 
Show References: