Function WMIExecQuery(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQuery :: Executes the WMI query and returns the result set.
'
'
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptError "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
End If
On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error Goto 0
If IsEmpty(oQuery) Or e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error Goto 0
If e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If
Set WMIExecQuery = oQuery
End Function
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
Function MomCreateObject(ByVal sProgramId)
Dim oError
Set oError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
oError.Save
On Error Goto 0
If oError.Number <> 0 Then ThrowScriptError "Unable to create automation object '" & sProgramId & "'", oError
End Function
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'
Dim sErrDescription, sErrNumber
sErrDescription = oErr.Description
sErrNumber = oErr.Number
On Error Resume Next
Dim oScriptErrorEvent
Set oScriptErrorEvent = ScriptContext.CreateEvent()
With oScriptErrorEvent
.EventNumber = 40000
.EventType = EVENT_TYPE_ERROR
.Message = sMessage
.SetEventParameter """Microsoft Windows DHCP Server"""
.SetEventParameter sMessage
.SetEventParameter sErrDescription
.SetEventParameter sErrNumber
End With
ScriptContext.Submit oScriptErrorEvent
ScriptContext.Echo "ThrowScriptError('" & sMessage & "')"
End Function
Function ThrowScriptError(Byval sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
ScriptContext.Quit()
End Function
' Event ID Constants
Const EVENT_ID_SUCCESS = 11504
Sub Main()
Dim dtStart
dtStart = Now
If Not ScriptContext.IsPerfData Then
ThrowScriptError "The script can only be executed by a performance rule.", Err
End If
Dim bFailed
bFailed = False
Dim dThresholdPrecentage
dThresholdPrecentage = CDbl(ScriptContext.Parameters.Get("RequestsVsOffersAndNacksThresholdPercent"))
Dim strInvalidParams
If (dThresholdPrecentage < 0) Or (dThresholdPrecentage > 100) Then
strInvalidParams = strInvalidParams & "RequestsVsOffersAndNacksThresholdPercent must be greater then 0 and less then 100." & vbCrLf & _
"The current value of the threshold is " & dThresholdPrecentage & vbCrLf & _
"the threshold will be set to 2 for " & _
"this execution of this script." & vbCrLf & vbCrLf
dThresholdPrecentage = 2
End If
Dim bLogSuccessEvent
bLogSuccessEvent = CBool(ScriptContext.Parameters.Get("LogSuccessEvent"))
If Len(strInvalidParams) > 0 Then
ThrowScriptError "Detected one or more invalid parameters." & vbCrLf & strInvalidParams, Err
End If
Dim oPerfData, oPerfDataCollection
Const WMI_QUERY = "select ReleasesPersec, NacksPersec, OffersPersec from Win32_PerfFormattedData_DHCPServer_DHCPServer"
Set oPerfDataCollection = WMIExecQuery("winmgmts:\\" & ScriptContext.TargetComputer & "\ROOT\CIMV2", WMI_QUERY)
For Each oPerfData In oPerfDataCollection
Exit For
Next
If Not IsValidObject(oPerfData) Then
ThrowScriptError "Could not execute the query '" & WMI_QUERY & "'." & vbCrLf & GetErrorString(Err), Err
End If
If dRequests <> 0 Then
Dim lProblemState
Dim lAlertLevel
dim difference
difference = abs(dRequests - (dNacks + dOffers)) 'get the difference of the releases less the responses
if (difference / dRequests) > dThresholdPrecentage then 'raise threshold error
lProblemState = PROBLEMSTATE_RED
lAlertLevel = ALERT_WARNING
Else
lProblemState = PROBLEMSTATE_GREEN
lAlertLevel = ALERT_INFORMATION
End If
Call CreateAlert("Performance Threshold: Requests vs. Offers and Nacks threshold exceeded.", _
"DHCP Requests are significantly different from Nacks and Offers.", _
"Microsoft Operations Manager", _
DHCP_CLASS_ID, _
ScriptContext.TargetNetbiosComputer, _
DHCP_PERFORMANCE_COMPONENT_ID, _
"",_
lProblemState, _
lAlertLevel)
End If
Set oPerfData = Nothing
If bLogSuccessEvent And Not(bFailed) Then
CreateEvent EVENT_ID_SUCCESS, EVENT_TYPE_INFORMATION, "The script '" & ScriptContext.Name & "' completed successfully in " & _
DateDiff("s", dtStart, Now) & " seconds."
end if
end sub
'******************************************************************************
' Name: GetErrorString
'
' 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.)
'
Function GetErrorString(oErr)
Dim lErr, strErr
lErr = oErr
strErr = oErr.Description
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 = MomCreateObject("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 = "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
' Name: CreateEvent
'
' Purpose: Creates a MOM event
'
' 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 CreateEvent(lngEventID, lngEventType, strMessage)
Dim objNewEvent
' Create a new event
Set objNewEvent = ScriptContext.CreateEvent
' Submit the event
ScriptContext.Submit objNewEvent
End Sub
'=============
' Method: CreateAlert
' Description: Creates an Alert for the specified Component (or Status Attribute)
' Parameters:
' strAlertName - Name of the alert to create. (Example: Windows Service Down)
' strDescription - Description of the alert.
' (Example: This Windows Service is set to Automatic start, but is currently not RUNNING).
' strSourceName - The source name (string) for this Alert. (Example: DNS Management Pack)
' strServerRole - Server role for which the alert occured.
' (Example: MOM Agent class, or DNS Class) - this is the name
' of the class definition from your Manangement pack schema
' strServerRoleInstance - The specific instance (primary key) of the Server Role class
' (Example: machinename1 - the primary key of MOM Agent class)
' this is the primary key of the class instance from your Management Pack schema
' strComponent - The Component (also known as Status Attribute) to set to Red state/Green state/Yellow state.
' (Example: ClusterSvc - the name of the Component )
' this the name of your status attribute from your Management pack schema
' strComponentInstance - The Component Instance (if any) from your management pack schema.
' Usually this is null (empty string).
' ProblemState - Problem state value (Red /Green / Grey etc).
' Values:
' (PROBLEMSTATE_NOTSET = 0,PROBLEMSTATE_GREEN = 1,PROBLEMSTATE_GREY = 2,
' PROBLEMSTATE_RED = 3)
' AlertLevel - The Alert level for the alert being created. Usually set to "ALERT_CRITICAL_ERROR" for Red and Green alerts.
' Ensure that a "Red" alert and a subsequent "Green" alert that resolves the earlier Red alert have the same AlertLevel.
' Values:
' (ALERT_SUCCESS = 10, ALERT_INFORMATION = 20, ALERT_WARNING = 30,
' ALERT_ERROR = 40, ALERT_CRITICAL_ERROR = 50, ALERT_SECURITY_BREACH = 60,
' ALERT_SERVICE_UNAVAILABLE = 70)
'=============
Public Sub CreateAlert(ByVal strAlertName, _
ByVal strDescription, _
ByVal strSourceName, _
ByVal strServerRole, _
ByVal strServerRoleInstance, _
ByVal strComponent,_
ByVal strComponentInstance, _
ByVal ProblemState, _
ByVal AlertLevel)
Dim alertHandle
Set alertHandle = ScriptContext.CreateAlert()
With alertHandle
.Name = strAlertName
.Description = strDescription
.AlertSource = strSourceName
.ServerRole = strServerRole
.ServerRoleInstance = strServerRoleInstance
.Component = strComponent
.ComponentInstance = strComponentInstance
.ProblemState = ProblemState
.AlertLevel = AlertLevel
End With
ScriptContext.Submit alertHandle
End Sub</Script></Body>
<Language>VBScript</Language>
<Name>Microsoft Windows DHCP Server Requests vs. Offers and Nacks Monitoring Script</Name>
<Parameters>
<Parameter>
<Name>LogSuccessEvent</Name>
<Value>$Config/Parameters/LogSuccessEvent$</Value>
</Parameter>
<Parameter>
<Name>RequestsVsOffersAndNacksThresholdPercent</Name>
<Value>$Config/Parameters/RequestsVsOffersAndNacksThresholdPercent$</Value>
</Parameter>
</Parameters>
<ManagementPackId>[Microsoft.Windows.Server.DHCP,,1.0.0.1]</ManagementPackId>
</WriteAction>
</MemberModules>
<Composition>
<Node ID="RunScriptAction"/>
</Composition>
</Composite>
</ModuleImplementation>
<InputType>SystemLibrary!System.BaseData</InputType>
</WriteActionModuleType>
Home