' Other Variables
Dim oParams, TargetFQDNComputer, TargetNetbiosDomain, bLogSuccessEvent, IsTargetAgentless
Set oParams = WScript.Arguments
if oParams.Count < 8 then
Wscript.Quit -1
End if
Dim oAPI, objAD, objParams, objEvent, oBag, oBagState
Set oAPI = CreateObject("Mom.ScriptAPI")
Err.Clear
Dim sStateValuePath, DIT_THRESHOLD, DIT_BOUNDARY, LOG_BOUNDARY, LOG_THRESHOLD
sStateValuePath= "HKLM\" & oAPI.GetScriptStateKeyPath(oParams(3))
' THRESHOLD and MINIMUM BOUNDARY for RESERVE SPACE
DIT_THRESHOLD = CDbl(oParams(4)) '%20
DIT_BOUNDARY = CDbl(oParams(5)) 'in KBytes
LOG_BOUNDARY = CDbl(oParams(6)) 'in KBytes
LOG_THRESHOLD = CDbl(oParams(7)) '%5 (NOTE: of the DIT size, not the log size)
' Registry Path to share data across scripts
Dim REG_Key
REG_Key = sStateValuePath & "\AD Management Pack\AD Database and Log"
Sub Main()
Dim dtStart
Dim lSizeDB, lFreeSpaceDB, lSizeLog, lFreeSpaceLog
Dim lReserveLog, lReserveDB
Dim strPathDB, strPathLog, strMessage, strComputer
Dim bSuccess
Set oBagState = oAPI.CreateTypedPropertyBag(StateDataType)
bSuccess = True
' Check this out TBD
If Not(IsTargetAgentless) Then
dtStart = Now
bLogSuccessEvent = CBool(oParams(2))'LogSuccessEvent
strComputer = TargetFQDNComputer
On Error Resume Next
Set objAD = CreateObject("McActiveDir.ActiveDirectory")
If (0 <> Err.Number) Or (Not(IsObject(objAD))) Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script '" & SCRIPT_NAME & "' failed to create object 'McActiveDir.ActiveDirectory'." & _
GetErrorString(Err)
Exit Sub
End If
objAD.Server = strComputer
If objAD.GetDatabaseInfo(strPathDB, lSizeDB, lFreeSpaceDB) Then
strPathDB = LCase(strPathDB)
Set oBag = oAPI.CreateTypedPropertyBag(PerformanceDataType)
oBag.AddValue "StatusCounter" , "Database Drive Free Space"
oBag.AddValue "StatusInstance" , strPathDB
oBag.AddValue "StatusValue", "" & lFreeSpaceDB
oAPI.AddItem oBag
Set oBag = oAPI.CreateTypedPropertyBag(PerformanceDataType)
oBag.AddValue "StatusCounter" , "Database Size"
oBag.AddValue "StatusInstance" , strPathDB
oBag.AddValue "StatusValue", "" & lSizeDB
oAPI.AddItem oBag
Else
bSuccess = False
strMessage = "The script '" & SCRIPT_NAME & "' was unable to obtain active directory database information on server '" & strComputer & "'." _
& vbCrLf & vbCrLf & "Error: " & objAD.LastError
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, strMessage
End If
If objAD.GetLogFileInfo(strPathLog, lSizeLog, lFreeSpaceLog) Then
Else
bSuccess = False
strMessage = "The script '" & SCRIPT_NAME & "' was unable to obtain active directory log file information on server '" & strComputer & "'." _
& vbCrLf & vbCrLf & "Error: " & objAD.LastError
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, strMessage
End If
Set objAD = Nothing
' If any of the previous code failed then we don't have enough information to
' complete the tests properly so don't do them.
If bSuccess Then
' calculate the reserve amount
lReserveLog = lSizeDB * CDbl(LOG_THRESHOLD)
If (lReserveLog < LOG_BOUNDARY) Then
lReserveLog = LOG_BOUNDARY
End If
lReserveDB = lSizeDB * CDbl(DIT_THRESHOLD)
If (lReserveDB < DIT_BOUNDARY) Then
lReserveDB = DIT_BOUNDARY
End If
' Get the old sizes
Dim lOldSizeDIT, lOldSizeLog, lOldFreeSpaceDB, lOldFreeSpaceLog, tempStr
tempStr = GetData("DITSize")
if tempStr <> "" Then
lOldSizeDIT = CDbl(tempStr)
Else
lOldSizeDIT = 0
End if
tempStr = GetData("LogSize")
if tempStr <> "" Then
lOldSizeLog = CDbl(tempStr)
Else
lOldSizeLog = 0
End if
tempStr = GetData("FreeDBSpace")
if tempStr <> "" Then
lOldFreeSpaceDB = CDbl(tempStr)
Else
lOldFreeSpaceDB = 0
End if
tempStr = GetData("FreeLogSpace")
if tempStr <> "" Then
lOldFreeSpaceLog = CDbl(tempStr)
Else
lOldFreeSpaceLog = 0
End if
' Update the old sizes
SetData "DITSize", lSizeDB
SetData "LogSize", lSizeLog
SetData "FreeDBSpace", lFreeSpaceDB
SetData "FreeLogSpace", lFreeSpaceLog
SetData "LastExecution", Now()
' Check the growth of the DIT and Logs, but only if first replication is not
' occurring
If Not InFirstReplication(strComputer) Then
Dim dtLastExec, deltaMinutes, deltaSize
dtLastExec = CDate(GetData("LastExecution"))
deltaMinutes = DateDiff("n", Now(), dtLastExec)
If 0 < CLng(lOldSizeDIT) Then
deltaSize = (lSizeDB - lOldSizeDIT) / lOldSizeDIT
If 0.2 < deltaSize Then
oBagState.AddValue "StateDBSIZE", "BAD"
CreateEvent EVENTID_DIT_GROWTH_WARNING, EVENT_TYPE_WARNING, _
"The size of the DIT file has grown " & CLng(deltaSize * 100) & _
"% in the last " & deltaMinutes & " minutes. If this is not " & _
"expected, the reason for this growth should be investigated."
Else
oBagState.AddValue "StateDBSIZE", "GOOD"
End If
End If
If 0 < CLng(lOldSizeLog) Then
deltaSize = (lSizeLog - lOldSizeLog) / lOldSizeLog
If 0.2 < deltaSize Then
oBagState.AddValue "StateLOGSIZE", "BAD"
CreateEvent EVENTID_LOG_GROWTH_WARNING, EVENT_TYPE_WARNING, _
"The size of the log file has grown " & CLng(deltaSize * 100) & _
"% in the last " & deltaMinutes & " minutes. If this is not " & _
"expected, the reason for this growth should be investigated."
Else
oBagState.AddValue "StateLOGSIZE", "GOOD"
End If
End If
End If
' check the size of log file and free space
Dim aComponents()
If Left(strPathDB, 2) = Left(strPathLog, 2) Then
'Log file and database file are on the same drive
If (lFreeSpaceDB < (lReserveDB + lReserveLog)) Then
bSuccess = False
strMessage = "Free space (" & lFreeSpaceDB & "KB) on drive " & UCase(Left(strPathDB, 2)) & " is lower than the required reserved space for AD Database and Log file. It should be at least " & (lReserveLog + lReserveDB) & " KBytes."
oBagState.AddValue "StateLOGFreeSpace", "GOOD"
If GetData(WARNING_TAG) = "True" Then
SetData WARNING_TAG, "False"
CreateEvent EVENTID_SPACE_AVAILABLE_WARNING, EVENT_TYPE_SUCCESS, strMessage
End If
End If
Else
'Log File and database file are on separate drives
If (lFreeSpaceDB < lReserveDB) Then
bSuccess = False
strMessage = "Free space (" & lFreeSpaceDB & "KB) on drive " & UCase(Left(strPathDB, 2)) & " is lower than the required reserved space for AD Database. It should be at least " & (lReserveDB) & " KBytes."
oBagState.AddValue "StateDBFreeSpace", "BAD"
CreateEvent EVENTID_SPACE_AVAILABLE_WARNING, EVENT_TYPE_ERROR, strMessage
SetData WARNING_TAG, "True"
Else
oBagState.AddValue "StateDBFreeSpace", "GOOD"
If GetData(WARNING_TAG) = "True" Then
SetData WARNING_TAG, "False"
CreateEvent EVENTID_SPACE_AVAILABLE_WARNING, EVENT_TYPE_SUCCESS, strMessage
End If
End If
If (lFreeSpaceLog < lReserveLog) Then
bSuccess = False
bSuccess = False
strMessage = "Free space (" & lFreeSpaceLog & "KB) on drive " & UCase(Left(strPathLog, 2)) & " is lower than the required reserved space for AD Log file. It should be at least " & (lReserveLog) & " KBytes."
oBagState.AddValue "StateLOGFreeSpace", "BAD"
Else
oBagState.AddValue "StateLOGFreeSpace", "GOOD"
If GetData(WARNING_TAG) = "True" Then
SetData WARNING_TAG, "False"
CreateEvent EVENTID_SPACE_AVAILABLE_WARNING, EVENT_TYPE_SUCCESS, strMessage
End If
End If
End If
If bLogSuccessEvent And bSuccess Then
strMessage = "The script '" & SCRIPT_NAME & "' completed successfully in " & _
DateDiff("s", dtStart, Now) & " seconds."
CreateEvent EVENTID_SUCCESS, EVENT_TYPE_INFORMATION, strMessage
End If
End If
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
oAPI.AddItem oBagState
oAPI.ReturnItems
'Else
'strMessage = "The script '" & SCRIPT_NAME & "' can only be executed by an event rule."
'CreateEvent EVENTID_EVENT_RULE_ONLY, EVENT_TYPE_WARNING, strMessage
'End If
End Sub
'******************************************************************************
' Name: CreateEvent
'
' Purpose: Creates a MOM event
'
' Parameters: lEventID, the ID for the event
' lEventType, the severity for the event. See constants at head of file
' strMessage, the message for the event
'
Sub CreateEvent(lEventID, lEventType, strMessage)
oAPI.LogScriptEvent "AD Database and Log",lEventID, lEventType, strMessage
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
'******************************************************************************
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 & "\" & 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 & "\" & strKey , strData )
Err.Clear
End Sub
'******************************************************************************
Function InFirstReplication(strDomainController)
'
' Purpose: To determine whether the domain controller is in a 'first
' replication' operation.
'
' Arguments: strDomainController - the name of the domain controller to be checked.
'
' Returns: Boolean - True if the DC is in First Replication, False otherwise.
'
' Remarks: The way to check to see if a naming context has succeeded following
' it's first replication is check if the attribute 'replUpToDateVector'
' exists. If it does exist then the naming context has completed it's
' first replication.
'
On Error Resume Next
Dim oRootDSE
Set oRootDSE = GetObject("LDAP://" & strDomainController & "/RootDSE")
If Err <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
"The script '" & SCRIPT_NAME & "' encountered an error while trying " & _
"to get the object 'LDAP://" & strDomainController & "/RootDSE'." & _
GetErrorString(Err)
Else
Dim upToDateVector
upToDateVector = oRootDSE.Get("replUpToDateVector")
If Err <> 0 Then
If Err = &H8000500d Then
' The attribute does not exist, we must be in first replication.
InFirstReplication = True
Else
' We could not get the vector. This should be because of a error.
CreateError EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
"The script '" & SCRIPT_NAME & "' encountered an error while trying " & _
"to read 'replUpToDateVector' on the object 'LDAP://" & strDomainController & _
"/RootDSE'." & GetErrorString(Err)
End If
End If
End If
End Function