'Event ID Constants
Const EVENTID_SCRIPT_ERROR = 1000
Const SCRIPT_NAME = "AS_LSASS_CPU.vbs"
Dim colOSes, colProcessors, nCores, colProcesses, nProcTime, nAdjustedProcTime
Dim oAPI, oBag, oWMI, oProcessor, oProcess
Sub Main()
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
On Error Resume Next
' Connect to WMI
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
If Err <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script " & SCRIPT_NAME & _
" failed to connect to WMI. The error was: " & GetErrorString(Err)
Else
' Get the processor information
Set colProcessors = oWMI.ExecQuery("Select NumberOfCores from Win32_Processor")
If Err <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script " & SCRIPT_NAME & _
" failed query WMI. The error was: " & GetErrorString(Err)
Else
' Get the number of cores in the system
nCores = 0
For Each oProcessor in colProcessors
nCores = nCores + oProcessor.NumberOfCores
Next
If Err <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script " & SCRIPT_NAME & _
" failed to retrieve the number of CPU cores. The error was: " & GetErrorString(Err)
Else
Set colProcesses = oWMI.ExecQuery("Select PercentProcessorTime from " _
& "Win32_PerfFormattedData_PerfProc_Process Where name='lsass'")
If Err <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script " & SCRIPT_NAME & _
" failed to query WMI for the LSASS utilization. The error was: " & GetErrorString(Err)
Else
For Each oProcess in colProcesses
nProcTime = oProcess.PercentProcessorTime
Next
If Err <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script " & SCRIPT_NAME & _
" failed to retrieve the LSASS utilization. The error was: " & GetErrorString(Err)
Else
nAdjustedProcTime = CDbl(nProcTime) / CDbl(nCores)
If Err <> 0 Then
CreateEvent EVENTID_SCRIPT_ERROR, EVENT_TYPE_WARNING, "The script " & SCRIPT_NAME & _
" failed to calculate the LSASS utilization. The error was: " & GetErrorString(Err)
Else
Call oBag.AddValue("Value", CInt(nAdjustedProcTime))
Call oAPI.Return(oBag)
End If
End If
End If
End If
End If
End If
End Sub
'******************************************************************************
Sub CreateEvent(lEventID, lEventType, strMessage)
'
' Purpose: Create a new event.
'
' Parameters: lEventID - The numerical ID of the event to create
' lEventType - The numerical ID of the event type
' strMessage - The message to include in the event
'
oAPI.LogScriptEvent "AD CPU Overload", 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