This probe is intended to be called from an administrative task and for the purpose of on-demand time checks on packages. It checks per server, per service, or per package, depending on the parameters passed in. The probe checks a script engine package's last processed timestamp and compares it against the current time, then determines if the time delta is within tolerance, or if the delta is above warning or critical time thresholds.
const SCRIPT_VERSION = "1.0"
dim WRITELINEHEADER
WRITELINEHEADER = "Amalga2009PackagesRunTimeReport.vbs" & vbcrlf & "Microsoft.Amalga.UIS.2009.Monitoring.ScriptEnginePackageRuntimeReportProbe" & vbcrlf & "script version: " & SCRIPT_VERSION & vbcrlf & "script start: " & now()
dim LogEnabled
LogEnabled = false
dim ManagedEntityId
ManagedEntityId = ""
Dim oAPI
Set oAPI = CreateObject("MOM.ScriptAPI")
dim DebugEventSource
dim LogEventSource
dim LogSeverity
LogSeverity = LOGSEVERITY_INFO
DebugEventSource = "$Config/DebugEventSource$"
if instr(DebugEventSource,"$") then
LogEventSource = "Amalga"
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in DebugEventSource - $ not translated - " & DebugEventSource
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
else
LogEventSource = trim(DebugEventSource & "")
if (LogEventSource = "") then
LogEventSource = "Amalga"
LogEnabled = true
LogSeverity = LOGSEVERITY_WARN
WriteLine "missing DebugEventSource, defaulting to 'Amalga'"
LogEnabled = false
LogSeverity = LOGSEVERITY_INFO
end if
end if
Dim oArgs
Set oArgs = WScript.Arguments
DumpArgs(oArgs)
if (oArgs.Count <> EXPECTED_PARAM_COUNT) then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "invalid arg count: " & oArgs.Count & " expected " & EXPECTED_PARAM_COUNT
oArgs = cdate("invalid arg count") ''' intentionally crash
end if
ManagedEntityId = GetArg(oArgs(0))
dim DebugEnabled
DebugEnabled = "$Config/DebugEnabled$"
if instr(DebugEnabled,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in DebugEnabled - $ not translated - " & DebugEnabled
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if
DebugEnabled = trim(ucase(DebugEnabled & " "))
LogEnabled = (DebugEnabled = "TRUE")
Dim gserviceinstancename, gpackagename, warningMinutes, criticalMinutes
gserviceinstancename = "$Config/ServiceInstanceName$"
if instr(gserviceinstancename,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in gserviceinstancename - $ not translated - " & gserviceinstancename
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if
gpackagename = "$Config/PackageName$"
if instr(gpackagename,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in gpackagename - $ not translated - " & gpackagename
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if
warningMinutes = "$Config/WarningMinutes$"
if instr(warningMinutes,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in warningMinutes - $ not translated - " & warningMinutes
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if
criticalMinutes = "$Config/CriticalMinutes$"
if instr(criticalMinutes,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in criticalMinutes - $ not translated - " & criticalMinutes
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if
WriteLine("LogEnabled=" & LogEnabled & "(DebugEnabled=" & DebugEnabled & ")")
WriteLine("serviceinstancename=" & gserviceinstancename)
WriteLine("packagename=" & gpackagename)
WriteLine("warningMinutes=" & warningMinutes)
WriteLine("criticalMinutes=" & criticalMinutes)
WriteLine("checking the registry for package's state keys")
dim oReg, strComputer, strKeyPath, arrValueNames, keyfound, LastUpdated, LastProcessed, strValueName, strValue, valuefound
dim ActiveTimeBias, deltayears, deltamonths, deltadays, deltahours, deltaminutes, deltaseconds, status, pos
dim Date1LessThanDate2, totalMinutesBehind
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If oReg.EnumKey (HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames) = 0 Then
WriteLine("The registry path exists " & strKeyPath)
keyfound = true
Else
WriteLine("The registry path does not exist " & strKeyPath)
keyfound = false
end if
if (keyfound) then
if (ucase(trim(gserviceinstancename)) = "ALL") then
wscript.echo "Enumerating all services, all packages"
call EnumerateServices()
else
if (ucase(trim(gpackagename)) = "ALL") then
wscript.echo "Enumerating all packages for service: " & gserviceinstancename
wscript.echo "----------"
call EnumeratePackages(gserviceinstancename)
else
wscript.echo "Getting report for service: " & gserviceinstancename & " package: " & gpackagename
wscript.echo "----------"
call ReportServiceTime(gserviceinstancename, gpackagename)
end if
end if
else
wscript.echo "ERROR: package state keys root not found"
end if
WriteLine("end script.")
'////////////////////////////
sub EnumerateServices()
dim oReg, strComputer, strKeyPath, arrSubKeys, i, serviceinstancename
wscript.echo "----------"
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
on error resume next
numSubKeys = UBound(arrSubKeys)
on error goto 0
if (numSubKeys >= 0) then
For i = 0 to numSubKeys
WriteLine("processing service " & i & "...")
serviceinstancename = arrSubKeys(i)
WriteLine("Service instance name: " & serviceinstancename)
call EnumeratePackages(serviceinstancename)
Next
else
WriteLine("The sub key count for services is < 1 (" & numSubKeys & ")")
end if
end sub
'////////////////////////////
sub EnumeratePackages(serviceinstancename)
dim oReg, strComputer, strKeyPath, arrSubKeys, i, packagename
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Amalga\2.0\ScriptEngine\DiscoveryData\ServiceInstances\" & serviceinstancename
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
dim numSubKeys
numSubKeys = -1
on error resume next
numSubKeys = UBound(arrSubKeys)
on error goto 0
if (numSubKeys >= 0) then
For i = 0 to numSubKeys
WriteLine("processing packagename " & i & "...")
packagename = arrSubKeys(i)
WriteLine("packagename name: " & packagename )
call ReportServiceTime(serviceinstancename, packagename)
Next
else
WriteLine("The sub key count for packages is < 1 (" & numSubKeys & ")")
end if
end sub
'////////////////////////////
sub ReportServiceTime(serviceinstancename, packagename)
dim strKeyPath
strKeyPath = "SOFTWARE\Microsoft\Amalga\SCOM\Volatile\2.0\ScriptEngine\" & serviceinstancename & "\" & packagename ''' not trailing backslash here
dim RegValuePrefixName
RegValuePrefixName = "MessagesReceived"
dim OldRetVal_MessagesReceived
OldRetVal_MessagesReceived = ucase(GetOldRetVal(strKeyPath, RegValuePrefixName))
dim serviceRunning, packageRunning
serviceRunning = IsServiceRunning(serviceinstancename)
packageRunning = false
if (not serviceRunning) then
retval = "SERVICE_STOPPED"
status = ""
elseif (OldRetVal_MessagesReceived = "NO_CHANGE") then
retval = "NO_CHANGE"
status = "'Message Received' counter has not moved since last check, assuming caught up."
else
packageRunning = IsPackageRunning(packagename)
if (not packageRunning) then
retval = "PACKAGE_STOPPED"
status = ""
elseif (OldRetVal_MessagesReceived = "") then
retval = "MISSING_REG"
status = ""
end if
end if
if (packageRunning) then
dim oReg, strComputer, arrSubKeys, i, keyfound, arrValueNames, strValueName, strValue
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Amalga\2.0\ScriptEngine\" & serviceinstancename & "\" & packagename & "\"
If oReg.EnumKey (HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames) = 0 Then
WriteLine("The registry path exists " & strKeyPath)
keyfound = true
Else
WriteLine("The registry path does not exist " & strKeyPath)
keyfound = false
end if
If (keyfound) Then
WriteLine("found package's state keys, starting building discovery objects")
strValueName = "Status.Processed.Last"
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
LastProcessed = strValue & ""
WriteLine("LastProcessed: " & LastProcessed)
if LastProcessed = "" then
LastProcessed = 0
valuefound = false
else
valuefound = true
end if
pos = instr(LastProcessed,".")
if (pos>0) then LastProcessed = left(LastProcessed,pos-1)
WriteLine("LastProcessed: " & LastProcessed)
LastUpdated = now()
WriteLine("LastUpdated: " & LastUpdated)
strValueName = "ActiveTimeBias"
oReg.GetDWORDValue HKEY_LOCAL_MACHINE,"System\CurrentControlSet\Control\TimeZoneInformation\",strValueName,strValue
ActiveTimeBias = strValue & ""
WriteLine("ActiveTimeBias: " & ActiveTimeBias)
if (ActiveTimeBias = "") then ActiveTimeBias = 0
WriteLine("ActiveTimeBias: " & ActiveTimeBias)
LastProcessed = DateAdd("n",(-1*ActiveTimeBias),LastProcessed)
WriteLine("LastProcessed: " & LastProcessed)
WriteLine ("totalMinutesBehind: " & totalMinutesBehind)
if (not valuefound) then
status = "The package has not process any messages. Status.Processed.Last value not found - " & strKeyPath
retval = "UNEXPECTED"
else
if (retval = "MISSING_REG") then
status = "Ensure the dependent monitor 'Package is receiving messages' is enabled."
elseif (not Date1LessThanDate2) then
status = "Last Processed (time zone adjusted) > Last Checked Time"
retval = "UNEXPECTED"
else
if (clng(totalMinutesBehind) > clng(criticalMinutes)) then
status = "delta is > " & criticalMinutes & " min (CRITICAL)"
retval = "CRITICAL"
else
if (clng(totalMinutesBehind) > clng(warningMinutes)) then
status = "delta is within " & warningMinutes & "-" & criticalMinutes & " min (WARNING)"
retval = "WARNING"
else
status = "delta is < " & warningMinutes & " min (HEALTHY)"
retval = "HEALTHY"
end if
end if
end if
end if
wscript.echo ucase(retval)
wscript.echo "Package:" & packagename
wscript.echo "Service:" & serviceinstancename
wscript.echo status
if (valuefound) then
wscript.echo "Last Checked Time:" & LastUpdated
wscript.echo "Last Processed:" & LastProcessed
wscript.echo "Warning Minutes Range:" & warningMinutes
wscript.echo "Critical Minutes Range:" & criticalMinutes
wscript.echo "Total Minutes Behind: " & totalMinutesBehind
wscript.echo "Delta Times: " & deltaYears & "y " & deltaMonths & "m " & deltaDays & "d " & deltaHours & "h " & deltaMinutes & "n " & deltaSeconds & "s"
end if
else
retval = "UNEXPECTED"
status = "timestamp keys not found - " & strKeyPath
wscript.echo ucase(retval)
wscript.echo status
wscript.echo "Package:" & packagename
wscript.echo "Service: " & serviceinstancename
end if
else '' package not running
wscript.echo ucase(retval)
if status <> "" then
wscript.echo status
end if
wscript.echo "Package:" & packagename
wscript.echo "Service: " & serviceinstancename
end if
sub DumpArgs(Args)
dim i, status
WriteLine("Dumping args as passed in.")
WriteLine("Note: If you see quotes, they are actually part of the argument literal.")
dim untranslated
untranslated = false
status = "Args: "
for i = 0 to Args.Count - 1
status = status & Args(i) & " "
WriteLine(i & ": " & Args(i))
if (instr(Args(i),"$") > 0) then
untranslated = true
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine("ERROR: untranslated $ encountered at arg " & i & ": " & Args(i))
end if
next
if (untranslated) then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine("ERROR: one or more untranslated $ args encountered, quitting.")
status = cdate("ERROR: one or more untranslated $ args encountered, quitting.") ''' intentionally crash here
end if
end sub
'////////////////////////////
function GetArg(quotedarg)
dim s
s = quotedarg
if s <> "" then
if mid(s,1,1) = """" then
s = mid(s,2, len(s)-1)
end if
if mid(s,len(s),1) = """" then
s = mid(s, 1, len(s)-1)
end if
end if
GetArg = s
end function
'////////////////////////////
sub WriteLine(in_line)
dim s
s = vbcrlf & "ID: " & ManagedEntityId & vbcrlf & WRITELINEHEADER & vbcrlf & vbcrlf & in_line
if (LogEnabled) then
wscript.echo in_line
call oAPI.LogScriptEvent(LogEventSource, 100, LogSeverity, s)
end if
end sub
'////////////////////////////
function GetDomainFromTargetComputer(machinename)
dim pos, temp
temp = machinename
temp = lcase(" " & temp & " ")
pos = instr(temp,".")
if (pos >0) then
GetDomainFromTargetComputer = trim(mid(temp,pos+1))
else
GetDomainFromTargetComputer = ""
end if
end function
'////////////////////////////
function GetNetBIOSNameFromTargetComputer(machinename)
dim pos, temp
temp = machinename
temp = lcase(" " & temp & " ")
pos = instr(temp,".")
if (pos >0) then
GetNetBIOSNameFromTargetComputer = trim(left(temp,pos-1))
else
GetNetBIOSNameFromTargetComputer = ""
end if
end function
'////////////////////////////
function NormalizeDate(x)
dim retval, i, L, c
L = len(x)
for i = 1 to L
c = ucase(mid(x,i,1))
if (instr("/:AMP ",c)=0) then
retval = retval & c
end if
next
NormalizeDate = retval
end function
'////////////////////////////
function GetDateDiff(date1,date2,y,m,d,h,n,s)
'' returns false if date1 > date2
dim x, d1, d2
d1 = date1
d2 = date2
if ( (datediff("yyyy",d1,d2) < 0) or (datediff("m",d1,d2) < 0) or (datediff("d",d1,d2) < 0) or (datediff("h",d1,d2) < 0) or (datediff("n",d1,d2) < 0) or (datediff("s",d1,d2) < 0) ) then
d1 = date2
d2 = date1
GetDateDiff = false ''' date1 not < date2 unexpected
else
d1 = date1
d2 = date2
GetDateDiff = true ''' date1 < date2 as expected
end if
x = datediff("yyyy",d1,d2)
y = x
d1 = dateadd("yyyy",x,d1)
if (datediff("s",d1,d2) < 0) then
d1 = dateadd("yyyy",-1,d1)
y = y -1
end if
WriteLine "years: " & y
x = datediff("m",d1,d2)
m = x
d1 = dateadd("m",x,d1)
if (datediff("s",d1,d2) < 0) then
d1 = dateadd("m",-1,d1)
m = m -1
end if
WriteLine "months behind: " & m
x = datediff("d",d1,d2)
d = x
d1 = dateadd("d",x,d1)
if (datediff("s",d1,d2) < 0) then
d1 = dateadd("d",-1,d1)
d = d -1
end if
WriteLine "days behind: " & d
x = datediff("h",d1,d2)
h = x
d1 = dateadd("h",x,d1)
if (datediff("s",d1,d2) < 0) then
d1 = dateadd("h",-1,d1)
h = h -1
end if
WriteLine "hours behind: " & h
x = datediff("n",d1,d2)
n = x
d1 = dateadd("n",x,d1)
if (datediff("s",d1,d2) < 0) then
d1 = dateadd("n",-1,d1)
n = n -1
end if
WriteLine "minutes behind: " & n
x = datediff("s",d1,d2)
s = x
d1 = dateadd("s",x,d1)
if (datediff("s",d1,d2) < 0) then
d1 = dateadd("s",-1,d1)
s = s -1
end if
WriteLine "seconds behind: " & s
end function
'////////////////////////////
Function IsServiceRunning(servicename)
dim strNamespace, objWMIService, strComputer, colserviceList
strNamespace = "\root\CIMV2"
Set objWMIService = GetObject("winmgmts:\\." & strNameSpace)
On Error Resume Next
strComputer = "."
Dim objServicesCimv2 ' As SWbemServicesEx
Set objServicesCimv2 = GetObject("winmgmts:\\" _
& strComputer & "\root\cimv2")
if err.number = 0 Then
set colserviceList = objServicesCimv2.ExecQuery("select name, StartMode, State from Win32_Service where name = '" & servicename & "'")
dim s
for each s in colservicelist
WriteLine ("service: " & s.name & " " & s.StartMode & " " & s.State)
if ( (lcase(trim(s.state & " ")) = "") or (lcase(trim(s.state & " ")) = "stopped") ) then
IsServiceRunning = false
else
IsServiceRunning = true
end if
exit function
next
Else
wscript.echo Err.Description
End If
wscript.echo "service '" & servicename & "' not found, assuming stopped"
IsServiceRunning = false
end function
'////////////////////////////
Function IsPackageRunning(packagename)
dim strNamespace, objWMIService, strComputer, colserviceList, objRefresher
strNamespace = "\root\CIMV2"
Set objWMIService = GetObject("winmgmts:\\." & strNameSpace)
On Error Resume Next
strComputer = "."
Set objRefresher = createobject("WbemScripting.SWbemRefresher")
Dim objServicesCimv2 ' As SWbemServicesEx
Set objServicesCimv2 = GetObject("winmgmts:\\" _
& strComputer & "\root\cimv2")
if err.number = 0 Then
Dim objRefreshableItem ' As SWbemRefreshableItem
Set objRefreshableItem = _
objRefresher.AddEnum(objServicesCimv2, _
"Win32_PerfFormattedData_AmalgaScriptEngine_AmalgaScriptEngine")
objRefresher.Refresh
objRefresher.Refresh
Dim process
dim counterval
dim retries
for retries = 1 to 10
objRefresher.Refresh
counterval = clng(-1)
For Each process In objRefreshableItem.ObjectSet
if ( lcase(trim(process.name & " ")) = lcase(trim(packagename & " ")) ) then
counterval = process.packagestopped
counterval = clng(counterval)
if err.number <> 0 then
counterval = clng(-1)
end if
WriteLine (process.name & " " & counterval)
if clng(counterval) <> clng(-1) then
IsPackageRunning = (clng(counterval) <> clng(1)) ''' 0 = running, 1 = stopped
exit function
else
WriteLine ("retrying to find the 'Package Stopped' counter")
end if
end if
Next
Next
WriteLine ("'Package Stopped' counter not found for package '" & packagename & "', assuming stopped after retries:" & (retries-1))
IsPackageRunning = false
Else
WriteLine (Err.Description)
WriteLine ("unable to connect to WMI \root\cimv2")
End If
end function
'////////////////////////////
Function GetOldRetVal(strKeyPath, RegValuePrefixName)
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If (oReg.EnumKey (HKEY_LOCAL_MACHINE, strKeyPath & "\", arrValueNames) = 0) Then
WriteLine("The registry path exists " & strKeyPath)
Else
WriteLine("The registry path does not exist " & strKeyPath)
exit Function
end if
strValueName = RegValuePrefixName & "_LastUpdatedRetVal"
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strValue = strValue & ""
Home
Show References: