<WriteActionModuleType ID="SMSv4_Monitor_Server_Health" Accessibility="Internal" Comment="{EC27E275-081D-4378-ADB9-F92C9B447A6A}">
<Configuration>
<IncludeSchemaTypes>
<SchemaType>MomBackwardCompatibility!System.Mom.BackwardCompatibility.AlertGenerationSchema</SchemaType>
</IncludeSchemaTypes>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="AlertGeneration" type="AlertGenerationType"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="InvokerType" type="xsd:integer"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="Parameters" minOccurs="0">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="ServerRole" type="xsd:string" minOccurs="0"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="ServerRole" Selector="$Config/Parameters/ServerRole$" ParameterType="string"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<WriteAction ID="RunScriptAction" TypeID="MomBackwardCompatibility!System.Mom.BackwardCompatibility.ScriptResponse">
<AlertGeneration>$Config/AlertGeneration$</AlertGeneration>
<InvokerType>$Config/InvokerType$</InvokerType>
<Body><Script>
'*******************************************************************************
' Script Name - ConfigMgr 2007 Monitor Server Health
'
' Purpose - Monitors the health of ConfigMgr 2007 Servers.
'
' Each health indicator is reported through the following event
' and event parameters.
'
' 1700 - An event used to report the health state for an SMS
' Server role.
'
' Paramter 1 SMS Server Role
'
' Paramter 2
' (Availability State) Condition
' -------------------- ---------
' 0 Online (healthy)
' 1 Failed (unhealthy)
' 2 Degraded (healthy)
' 3 Offline (healthy)
'
' Paramter 3+ Reserved for future heath indicators i.e.
' configuration, performance and security.
'
' The following additional events can be raised:
'
' 1100 - An event used only for debugging or tracing.
' 1101 - Script executed successfully.
' 1102 - An error occurred in executing this script.
'
' Paramter 1 The ID of the rule under which this
' script is launched.
'
' 1105 - Accessed denied due to connection failure or permissions.
'
' Assumptions - This script will only run on ConfigMgr 2007 Servers.
'
' Parameters - ServerRole The role that this server has i.e. MP, SHV, etc.
'
' Change Hist - Date Version Description
' -------- --------------- -----------
' 04/08/06 05.0.2902.0000 Created
' 08/02/07 05.0.2906.0000 Updated to proxy event creation for
' the "SMS SQL Server" role when
' required.
' 08/18/07 6.0.5000.2 Added event tracing support.
' 09/21/07 6.0.5000.6 Changed function
' CheckWow64RegistryKeyExists() to
' not just check for the Wow6432Node
' key but also the SMS key under it.
'
' (c) Copyright 2007, Microsoft Corp., All Rights Reserved
'*******************************************************************************
'Event and Log Messages Constants
'================================
'Start Localization
Const WMI_NO_NAMESPACE_SOURCE = "Unable to open WMI Namespace {Namespace}"
Const WMI_NO_NAMESPACE_DESCRIPTION = "Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists. Error:{ErrorNumber}, {ErrorDescription}."
Const WMI_NO_INSTANCES_SOURCE = "The class name '{ClassName}' returned no instances."
Const WMI_NO_INSTANCES_DESCRIPTION = "Please check to see if this is a valid WMI class name. Error:{ErrorNumber}, {ErrorDescription}."
Const WMI_NO_VALID_INSTANCES_SOURCE = "The class name '{ClassName}' did not return any valid instances."
Const WMI_NO_VALID_INSTANCES_DESCRIPTION = "Please check to see if this is a valid WMI class name. Error:{ErrorNumber}, {ErrorDescription}."
Const WMI_QUERY_NO_RESULTS_SOURCE = "The Query '{Query}' returned an invalid result set."
Const WMI_QUERY_NO_RESULTS_DESCRIPTION = "Please check to see if this is a valid WMI Query. Error:{ErrorNumber}, {ErrorDescription}."
Const WMI_QUERY_NO_VALID_INSTANCES_SOURCE = "The Query '{Query}' did not return any valid instances."
Const WMI_QUERY_NO_VALID_INSTANCES_DESCRIPTION = "Please check to see if this is a valid WMI Query. Error:{ErrorNumber}, {ErrorDescription}."
'End Localization
Dim g_oUtil ' Utility class for MOM events, logging and registry access.
'******************************************************************************
' Replacement string functions for event and log messages
'
'
Function GET_WMI_NO_NAMESPACE_SOURCE(ByVal sNamespace)
GET_WMI_NO_NAMESPACE_SOURCE = Replace(WMI_NO_NAMESPACE_SOURCE, "{Namespace}", sNamespace)
End Function
Function GET_WMI_NO_NAMESPACE_DESCRIPTION(ByVal lErrorNumber, ByVal sErrorDescription)
Dim sResult
sResult = Replace(WMI_NO_NAMESPACE_DESCRIPTION, "{ErrorNumber}", lErrorNumber)
GET_WMI_NO_NAMESPACE_DESCRIPTION = Replace(sResult, "{ErrorDescription}", sErrorDescription)
End Function
Function GET_WMI_NO_INSTANCES_SOURCE(ByVal sClassName)
GET_WMI_NO_INSTANCES_SOURCE = Replace(WMI_NO_INSTANCES_SOURCE, "{ClassName}", sClassName)
End Function
Function GET_WMI_NO_INSTANCES_DESCRIPTION(ByVal lErrorNumber, ByVal sErrorDescription)
Dim sResult
sResult = Replace(WMI_NO_INSTANCES_DESCRIPTION, "{ErrorNumber}", lErrorNumber)
GET_WMI_NO_INSTANCES_DESCRIPTION = Replace(sResult, "{ErrorDescription}", sErrorDescription)
End Function
Function GET_WMI_NO_VALID_INSTANCES_SOURCE(ByVal sClassName)
GET_WMI_NO_VALID_INSTANCES_SOURCE = Replace(WMI_NO_VALID_INSTANCES_SOURCE, "{ClassName}", sClassName)
End Function
Function GET_WMI_NO_VALID_INSTANCES_DESCRIPTION(ByVal lErrorNumber, ByVal sErrorDescription)
Dim sResult
sResult = Replace(WMI_NO_VALID_INSTANCES_DESCRIPTION, "{ErrorNumber}", lErrorNumber)
GET_WMI_NO_VALID_INSTANCES_DESCRIPTION = Replace(sResult, "{ErrorDescription}", sErrorDescription)
End Function
Function GET_WMI_QUERY_NO_RESULTS_SOURCE(ByVal sQuery)
GET_WMI_QUERY_NO_RESULTS_SOURCE = Replace(WMI_QUERY_NO_RESULTS_SOURCE, "{Query}", sQuery)
End Function
Function GET_WMI_QUERY_NO_RESULTS_DESCRIPTION(ByVal lErrorNumber, ByVal sErrorDescription)
Dim sResult
sResult = Replace(WMI_QUERY_NO_RESULTS_DESCRIPTION, "{ErrorNumber}", lErrorNumber)
GET_WMI_QUERY_NO_RESULTS_DESCRIPTION = Replace(sResult, "{ErrorDescription}", sErrorDescription)
End Function
Function GET_WMI_QUERY_NO_VALID_INSTANCES_DESCRIPTION(ByVal lErrorNumber, ByVal sErrorDescription)
Dim sResult
sResult = Replace(WMI_QUERY_NO_VALID_INSTANCES_DESCRIPTION, "{ErrorNumber}", lErrorNumber)
GET_WMI_QUERY_NO_VALID_INSTANCES_DESCRIPTION = Replace(sResult, "{ErrorDescription}", sErrorDescription)
End Function
Function GET_WMI_QUERY_NO_VALID_INSTANCES_SOURCE(ByVal sQuery)
GET_WMI_QUERY_NO_VALID_INSTANCES_SOURCE = Replace(WMI_QUERY_NO_VALID_INSTANCES_SOURCE, "{Query}", sQuery)
End Function
'******************************************************************************
' Name: Main
'
' Purpose: Entry point for program execution.
'
' Parameters: None
'
' Returns: Nothing
'
Sub Main()
Dim bEventTracing
Dim strServerRole
Dim strError
On Error Resume Next
LogMessage DBG_TRACE, ScriptContext.Name & " script starting at local time: " & CStr(Time) & _
" under processing rule " & ScriptContext.ProcessingRule.Name & "."
'Check if event tracing is configured. If it is, raise a start event.
'=====================================================================
bEventTracing = IsEventTracingEnabled()
If (bEventTracing = True) Then
LogEvent EVENT_ID_NOTANEVENT, EVENT_TYPE_INFORMATION, "started at local time: " & CStr(Time)
End If
'Initialize utility object and set tracing level for it.
'=======================================================
Set g_oUtil = new Util
If IsEmpty(g_oUtil) Then
LogMessage DBG_TRACE, "Failed to instantiate Util object."
ScriptError "instantiate Util object."
LogMessage DBG_TRACE, ScriptContext.Name & " script completed at local time: " & CStr(Time)
Exit Sub
End If
g_oUtil.SetDebugLevel g_oUtil.DBG_NONE
'WMI is used by the monitoring functions in this script so check that
'the relevant name spaces are accessible.
'====================================================================
If True <> IsWMIAccessible() Then
Set g_oUtil = Nothing
LogMessage DBG_TRACE, ScriptContext.Name & " script completed at local time: " & CStr(Time)
Exit Sub
End if
If ((0 <> Err.number) or _
IsEmpty(strServerRole)) Then
strError = GetErrorString(Err)
LogMessage DBG_ERROR, "Failed to get script parameter " & SCRIPT_PARAM_SERVER_ROLE & " or invalid value." & strError
ScriptError "get script parameter " & SCRIPT_PARAM_SERVER_ROLE & " or invalid value." & strError
Set g_oUtil = Nothing
LogMessage DBG_TRACE, ScriptContext.Name & " script completed at local time: " & CStr(Time)
Exit Sub
End If
'Perform health check for the specified server role.
'===================================================
CheckHealth strServerRole
If (bEventTracing = True) Then
LogEvent EVENT_ID_SCRIPTSUCCESS, EVENT_TYPE_INFORMATION, "completed at local time: " & CStr(Time)
End If
LogMessage DBG_TRACE, ScriptContext.Name & " script completed at local time: " & CStr(Time) & _
" under processing rule " & ScriptContext.ProcessingRule.Name & "."
Set g_oUtil = Nothing
End Sub
'******************************************************************************
' Name: IsWMIAccessible
'
' Purpose: To determine whether the WMI service is running and accessible
'
' Parameters: None
'
' Returns: Boolean, returns True if the WMI service and root\default namespace
' is accessible.
'
Function IsWMIAccessible()
Dim objService
On Error Resume Next
Err.Clear
Set objService = GetObject("winmgmts:\\" + ScriptContext.TargetComputer + "\root\default")
If Err Then
IsWMIAccessible = False
LogMessage DBG_ERROR, "WMI Access Failure, Error #: " + CStr(Err.Number) + ", Description: " + Err.Description
ScriptError "connect to WMI name space '\root\default'." & GetErrorString(Err)
Else
IsWMIAccessible = True
End If
End Function
'******************************************************************************
' Name: CheckHealth
'
' Purpose: Checks the health of the specified server role. If the health
' state has changed, the new state is reported. Health indicators
' can be availability, configuration, performance and security.
'
' Parameters: strServerRole, the SMS Server role
'
' Returns: Nothing
'
Sub CheckHealth(strServerRole)
Dim intCurrentAvailabilityState
Dim bAvailabilityStateChanged
On Error Resume Next
'Check input parameter.
'======================
If IsEmpty(strServerRole) Then
Err.Raise ERROR_INVALID_PARAMETER
Exit Sub
End If
'Check availability.
'Note, presently only availability state exists.
'===============================================
If ((0 <> Err.number) or _
IsEmpty(intCurrentAvailabilityState) or _
IsEmpty(bAvailabilityStateChanged)) Then
Exit Sub
End If
'If a state change has occurred, raise an event to report it.
'============================================================
If (bAvailabilityStateChanged = True) Then
CreateHealthStateEvent strServerRole, intCurrentAvailabilityState
End If
End Sub
'******************************************************************************
' Name: CheckHealthState
'
' Purpose: Checks if the specified server role's health state has changed
' and returns the current state value.
'
' Parameters: strServerRole, the SMS Server role
' strStateName, the state value to get i.e. Availability State.
' intCurrentState, the current state value.
' bStateChanged, flag to indicate that a state change occurred.
'
' Returns: Nothing
'
Sub CheckHealthState(strServerRole, strStateName, intCurrentState, bStateChanged)
Dim strError
Dim intPreviousState
On Error Resume Next
'Check input parameter.
'======================
If IsEmpty(strServerRole) Then
Err.Raise ERROR_INVALID_PARAMETER
strError = GetErrorString(Err)
ScriptError "get valid server role input parameter." & strError
LogMessage DBG_ERROR, "Failed to get valid server role input parameter." & strError
Exit Sub
End If
'Get the current state value.
'============================
If IsEmpty(intCurrentState) Then
ScriptError "get " & strServerRole & " " & strStateName & "."
LogMessage DBG_ERROR, "Failed to get " & strServerRole & " " & strStateName & "."
Exit Sub
End If
LogMessage DBG_TRACE, "Current " & strServerRole & " " & strStateName & " = " & intCurrentState
'Get the previous saved state.
'=============================
'If there was no previous health state or if the state has changed,
'save the current state and submit an event for the new state.
'==================================================================
If IsEmpty(intPreviousState) Or (intPreviousState <> intCurrentState) Then
SetPreviousHealthState strServerRole, strStateName, intCurrentState
bStateChanged = True
Else
bStateChanged = False
End If
If 0 <> Err.number Then
strError = GetErrorString(Err)
ScriptError "check " & strServerRole & " " & strStateName & "." & strError
LogMessage DBG_ERROR, "Failed to ckeck " & strServerRole & " " & strStateName & "." & strError
End If
End Sub
'******************************************************************************
' Name: GetHealthState
'
' Purpose: Get the current health state from the registry.
'
' Parameters: strServerRole, the SMS Server role
' strStateName, the state value to get i.e. Availability State.
'
' Returns: String, returns zero or nonzero value for the specified health
' state. An empty string is returned if the value could not be
' found or accessed.
'
' Remarks: If an error is encountered this function will throw an exception
' and the caller MUST handle this.
'
Function GetHealthState(strServerRole, strStateName)
Dim strRegPath
On Error Resume Next
strRegPath = g_oUtil.REG_KEY_SMS_SERVER_OPERATIONS_MANAGEMENT_SMS_SERVER_ROLE_BASE & strServerRole
'******************************************************************************
' Name: GetPreviousHealthState
'
' Purpose: Retrieves previously saved health state value out of a varset.
'
' Parameters: strServerRole, the SMS Server role
' strStateName, the state value to get i.e. Availability State.
'
' Returns: Integer, the data to return or zero
'
Function GetPreviousHealthState(strServerRole, strStateName)
Dim strVarsetName
Dim objScriptState
Dim objVarSet
On Error Resume Next
strVarsetName = "ConfigMgr 2007 Monitor " & strServerRole & " Health"
Set objScriptState = ScriptContext.GetScriptState()
Set objVarSet = objScriptState.GetSet(strVarsetName)
Set objVarSet = Nothing
Set objScriptState = Nothing
End Function
'******************************************************************************
' Name: SetPreviousHealthState
'
' Purpose: Saves the specified health state value 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: strServerRole, the SMS Server role
' strStateName, the state value to get i.e. Availability State.
' intData, the health state value to save
'
' Returns: Nothing
'
Sub SetPreviousHealthState(strServerRole, strStateName, intData)
Dim strVarsetName
Dim objScriptState
Dim objVarSet
On Error Resume Next
'Get the varset for the specified server role. If it does not exist,
'create it.
'====================================================================
strVarsetName = "ConfigMgr 2007 Monitor " & strServerRole & " Health"
Set objScriptState = ScriptContext.GetScriptState()
Set objVarSet = objScriptState.GetSet(strVarsetName)
If IsEmpty(objVarSet) Then
objVarSet = objScriptState.CreateSet()
End If
'Set, the health state.
'======================
objVarSet.put strStateName, intData
objScriptState.SaveSet strVarsetName, objVarSet
Set objVarSet = Nothing
Set objScriptState = Nothing
End Sub
'******************************************************************************
' Name: GetSiteServerDomain
'
' Purpose: Gets the domain that the Site Server is in.
'
' Parameters: None
'
' Returns: Registry key string value SOFTWARE\Microsoft\SMS\Identification\
' Site Server Domain
'
Function GetSiteServerDomain()
'******************************************************************************
' Name: GetSQLServerName
'
' Purpose: Gets the name of the SQL Server hosting the SMS Site Database.
'
' Parameters: None
'
' Returns: Registry key string value SOFTWARE\Microsoft\SMS\SQL Server\
' Server
'
Function GetSQLServerName()
'******************************************************************************
' Name: CreateHealthStateEvent
'
' Purpose: To generate a MOM event with parameters containing the specified
' server role name and its health states.
'
' Parameters: strServerRole, the SMS Server role
' intAvailabilityState, the current state.
'
' Returns: Nothing
'
Sub CreateHealthStateEvent(strServerRole, intAvailabilityState)
'If the SQL Server is not the local computer, proxy, create the
'event on behalf of that computer.
'==============================================================
strSQLServer = GetSQLServerName()
If (strSQLServer <> ScriptContext.TargetNetbiosComputer) Then
'It is required that the SQL Server be in the same domain as the
'Site Server
'===============================================================
'oEvent.SourceDomain = "DOMAIN" ' Domain of SourceComputer
'oEvent.SourceComputer = "MachineName" ' Must be a MOM Agent
oEvent.LoggingDomain = GetSiteServerDomain() ' Domain of LoggingComputer
oEvent.LoggingComputer = strSQLServer ' Doesn't have to be a MOM Agent
strMessage = "The health state for this '%1' in site '%3'"
If intAvailabilityState = 0 Then
strMessage = strMessage & "' is healthy."
Else
strMessage = strMessage & "' is unhealthy."
End If
oEvent.Message = strMessage
LogMessage DBG_TRACE, strMessage
LogMessage DBG_TRACE, "Submitting event " & EVENT_ID_SERVER_HEALTH & _
" with Availability State = " & intAvailabilityState & "."
'Submit, raise, this event to MOM.
'=================================
ScriptContext.Submit oEvent
'Cleanup
'=======
Set oEvent = Nothing
End Sub
'******************************************************************************
' Name: GetSMSSiteCode
'
' Purpose: Get the SMS Site Code from the registry.
'
' Parameters: None
'
' Returns: String, returns the SMS Site Code if successful otherwise empty.
'
' Remarks: If an error is encountered this function will throw an exception
' and the caller MUST handle this.
'
Function GetSMSSiteCode()
If IsEmpty(strSiteCode) Then
strSiteCode = g_oUtil.ReadRegistryStringValue(g_oUtil.HKEY_LOCAL_MACHINE, g_oUtil.REG_KEY_SMS_SERVER_IDENTIFICATION, g_oUtil.REG_VALUE_SMS_SERVER_SITE_CODE)
End If
GetSMSSiteCode = strSiteCode
End Function
'******************************************************************************
' 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
'
' Returns: String, the description for the error. (Includes the error code.)
'
Function GetErrorString(oErr)
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 & "' " & lErr & " (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
' Name: ScriptError
'
' Purpose: To generate a warning about a runtime script error.
'
' Parameters: strError, the description of the error
'
' Returns: Nothing
'
Sub ScriptError(strError)
LogEvent EVENT_ID_SCRIPTERROR, EVENT_TYPE_WARNING, "encountered a runtime error." & vbCrLf & "Failed to " & strError
End Sub
'******************************************************************************
' Name: LogEvent
'
' Purpose: To generate a MOM event
'
' Parameters: lEventID, the event code
' lEventType, the severity of the event
' strMessage, the message to include in the event
'
' Returns: Nothing
'
Sub LogEvent(lEventID, lEventType, strMessage)
objEvent.Message = "The script '%2' running under processing rule '%3' %4"
ScriptContext.Submit objEvent
End Sub
'******************************************************************************
' Name: LogMessage
'
' Purpose: To log a message to ScriptContext and MOM's agent response log.
'
' Parameters: lLevel The debug level for this message i.e. trace,
' warning or error
' strMessage The message to write
'
' Returns: Nothing
'
Sub LogMessage(lLevel, strMessage)
If (lLevel < DBG_NONE) Then
If (lLevel = DBG_ERROR) Then
ScriptContext.Echo "[Error]: " + strMessage
ElseIf (lLevel = DBG_WARNING) Then
ScriptContext.Echo "[Warning]: " + strMessage
ElseIf (lLevel = DBG_TRACE) Then
ScriptContext.Echo "[Trace]:" + strMessage
End If
End If
End Sub
'==========================================================================
' Class: Util
' Description: Wrapper around WMI.
'==========================================================================
Class Util
'---------------
' Constants (Initialized on constructor due to VBS behavior)
'---------------
' Used to indicate to LogMessage when/how to print the message.
Public DBG_NONE
Public DBG_ERROR
Public DBG_WARNING
Public DBG_TRACE
'Internal Debug Level
Private m_nDebugLevel
'Registry root constants
Public HKEY_CLASSES_ROOT
Public HKEY_CURRENT_USER
Public HKEY_LOCAL_MACHINE
Public HKEY_USERS
Public HKEY_CURRENT_CONFIG
Public HKEY_DYN_CONFIG
'Registry path and key name constants
Public REG_PATH_SMS
Public REG_PATH_SMS_BASE
Public REG_PATH_SMS_CLIENT
Public REG_PATH_SMS_SERVER
Public REG_KEY_SMS_SERVER_IDENTIFICATION
Public REG_KEY_SMS_SERVER_OPERATIONS_MANAGEMENT
Public REG_KEY_SMS_SERVER_SETUP
Public REG_KEY_SMS_SERVER_SQL_SERVER
Public REG_KEY_SMS_SERVER_OPERATIONS_MANAGEMENT_BASE
Public REG_KEY_SMS_SERVER_OPERATIONS_MANAGEMENT_SMS_SERVER_ROLE
Public REG_KEY_SMS_SERVER_OPERATIONS_MANAGEMENT_SMS_SERVER_ROLE_BASE
'Registry key value name constants
Public REG_VALUE_SMS_CLIENT_VERSION
Public REG_VALUE_SMS_CLIENT_SITE_CODE
Public REG_VALUE_SMS_SERVER_VERSION
Public REG_VALUE_SMS_SERVER_FULL_VERSION
Public REG_VALUE_SMS_SERVER_SITE_CODE
Public REG_VALUE_SMS_SERVER_SERVER
Public REG_VALUE_SMS_SERVER_SITE_SERVER_DOMAIN
'---------------
' Methods
'---------------
'=============
' Method: Class_Initialize
' Description: This is the constructor
' Parameters:
'=============
Private Sub Class_Initialize()
'Initialize Debug level constants
DBG_TRACE = 1
DBG_WARNING = 2
DBG_ERROR = 3
DBG_NONE = 4
'by default only errors are logged
m_nDebugLevel = DBG_ERROR
'Removing use of unreliable CheckWow64RegistryKeyExists function
'If (CheckWow64RegistryKeyExists() = True) Then
' REG_PATH_SMS = "SOFTWARE\Wow6432Node\Microsoft\SMS"
'Else
' REG_PATH_SMS = "SOFTWARE\Microsoft\SMS"
'End If
'Adding this instead
On Error Resume Next
Dim sCimv2namespace, sProcArchQuery, oProcArchObjectSet, oProcArchObject, sProcArch
sCimv2namespace = "winmgmts:\\.\root\cimv2"
sProcArchQuery = "Select * From Win32_Environment Where Name = ""Processor_Architecture"""
Set oProcArchObjectSet = WMIExecQuery (sCimv2namespace, sProcArchQuery)
Set oProcArchObject = oProcArchObjectSet.Item("Win32_Environment.Name=""PROCESSOR_ARCHITECTURE"",UserName=""<SYSTEM>""")
sProcArch = oProcArchObject.VariableValue
On Error GoTo 0
Select Case sProcArch
Case "AMD64"
REG_PATH_SMS = "SOFTWARE\Wow6432Node\Microsoft\SMS"
Case "x86"
REG_PATH_SMS = "SOFTWARE\Microsoft\SMS"
Case Else
ScriptError "read %PROCESSOR_ARCHITECTURE environment variable from Win32_Environment WMI class."
End Select
'=============
' Method: Class_Terminate
' Description: This is the destructor
' Parameters:
'=============
Private Sub Class_Terminate()
End Sub
'=============
' Method: SetDebugLevel
' Description: To change the debugging output level of information
' generated by this utility.
' Parameters:
' nLevel - Level, either DBG_NONE, DBG_TRACE,
' DBG_WARNING or DBG_ERROR
'=============
Public Sub SetDebugLevel(ByVal nLevel)
m_nDebugLevel = nLevel
End Sub
'=============
' Method: LogMessage
' Description: Log a debug message to ScriptContext
' Parameters:
' nLevel - Debug level for the message that we're logging.
' strMessage - The message to write to the trace.
'=============
Public Sub LogMessage(ByVal nLevel, ByVal strMessage)
If (nLevel <= m_nDebugLevel) Then
If (nLevel = DBG_ERROR) Then
ScriptContext.Echo "[Error]: " + strMessage
ElseIf (nLevel = DBG_WARNING) Then
ScriptContext.Echo "[Warning]: " + strMessage
ElseIf (nLevel = DBG_TRACE) Then
ScriptContext.Echo "[Trace]:" + strMessage
End If
End If
End Sub
'=============
' Method: ReadRegistryStringValue
' Description: Used to read strings from the registry
' Parameters:
' lHive - Registry hive or root i.e. HKEY_LOCAL_MACHINE
' strKeyPath - Key path for the Registry key to read
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' strValueName - Name of the registry value to read (like "SoftwareType")
'
' Returns:
' The value of the registry key specified. "Nothing" if it fails.
' Callee needs to handle null value return.
'=============
Public Function ReadRegistryStringValue(ByVal lHive, ByVal strKeyPath, ByVal strValueName)
'Read from value from registry
if oReg.GetStringValue(lHive, strKeyPath, strValueName, strValueData) = 0 Then
Call LogMessage(DBG_TRACE, "Value of Registry Key: " + strKeyPath + "\" + strValueName + " = " + strValueData)
ReadRegistryStringValue = strValueData
Else
Call LogMessage(DBG_ERROR, "Reading Registry Key: " + strKeyPath + "\" + strValueName + " Failed!" )
ReadRegistryStringValue = Empty
End If
Set oReg = Nothing
End Function
'=============
' Method: ReadRegistryDWORDValue
' Description: Used to read DWORDs from the registry
' Parameters:
' lHive - Registry hive or root i.e. HKEY_LOCAL_MACHINE
' strKeyPath - Key path for the Registry key to read
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' strValueName - Name of the registry value to read (like "SoftwareType")
'
' Returns:
' The value of the registry key specified. "Nothing" if it fails.
' Callee needs to handle null value return.
'=============
Public Function ReadRegistryDWORDValue(ByVal lHive, ByVal strKeyPath, ByVal strValueName)
'Read value from registry
if oReg.GetDWORDValue(lHive, strKeyPath, strValueName, lValueData) = 0 Then
Call LogMessage(DBG_TRACE, "Value of Registry Key: " + strKeyPath + "\" + strValueName + " = " & lValueData)
ReadRegistryDWORDValue = lValueData
Else
Call LogMessage(DBG_ERROR, "Reading Registry Key: " + strKeyPath + "\" + strValueName + " Failed!" )
ReadRegistryDWORDValue = Empty
End If
Set oReg = Nothing
End Function
'=============
' Method: EnumRegistryKeys
' Description: Used to enumerate registry keys under a given path
' Parameters:
' lHive - Registry hive or root i.e. HKEY_LOCAL_MACHINE
' strKeyPath - Key path for the Registry key to read
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' Returns:
' The list of registry keys found under the path. "null" if the list is empty
'=============
Public Function EnumRegistryKeys(ByVal lHive, ByVal strKeyPath)
'Enumerate keys in registry
if oReg.EnumKey(lHive, strKeyPath, arrKeys) = 0 Then
Call LogMessage(DBG_TRACE, "Found [" + arrKeys(0) + "] key in path : " + strKeyPath )
EnumRegistryKeys = arrKeys
Else
Call LogMessage(DBG_ERROR, "Error enumerating Registry Keys under path : " + strKeyPath )
End If
Set oReg = Nothing
End Function
'=============
' Method: CheckRegistryKeyAccess
' Description: Used to check permissions access to a registry key
' Parameters:
' lHive - Registry hive or root i.e. HKEY_LOCAL_MACHINE
' strKeyPath - Key path for the Registry key to check access
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' lAccess - required permissions i.e. KEY_QUERY_VALUE + KEY_SET_VALUE
' Returns:
' True if the specified permissions are present on the registry key else false.
'=============
Public Function CheckRegistryKeyAccess(ByVal lHive, ByVal strKeyPath, ByVal lAccess)
'Check access to the specified registry key
if oReg.CheckAccess(lHive, strKeyPath, lAccess, bGranted) = 0 Then
Call LogMessage(DBG_TRACE, "Required access present on registry key : " + strKeyPath )
CheckRegistryKeyAccess = bGranted
Else
Call LogMessage(DBG_ERROR, "Error checking access on registry keys : " + strKeyPath )
CheckRegistryKeyAccess = False
End If
Set oReg = Nothing
End Function
'=============
' Method: CheckRegistryKeyExists
' Description: Used to check existence of a registry key
' Parameters:
' lHive - Registry hive or root i.e. HKEY_LOCAL_MACHINE
' strKeyPath - Key path for the Registry key to check access
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' Returns:
' True if the registry key exists else false.
'=============
Public Function CheckRegistryKeyExists(ByVal lHive, ByVal strKeyPath)
'=============
' Method: CheckRegistryKeyStringValueExists
' Description: Used to check existence of a registry key string value
' Parameters:
' lHive - Registry hive or root i.e. HKEY_LOCAL_MACHINE
' strKeyPath - Key path for the Registry key to check access
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' Returns:
' True if the string value exists else false.
'=============
Public Function CheckRegistryKeyStringValueExists(ByVal lHive, ByVal strKeyPath, ByVal strValueName)
If IsEmpty(strValue) Then
CheckRegistryKeyStringValueExists = False
Else
CheckRegistryKeyStringValueExists = True
End If
End Function
'=============
' Method: CheckRegistryKeyDWORDValueExists
' Description: Used to check existence of a registry key DWORD value
' Parameters:
' lHive - Registry hive or root i.e. HKEY_LOCAL_MACHINE
' strKeyPath - Key path for the Registry key to check access
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' Returns:
' True if the DWORD value exists else false.
'=============
Public Function CheckRegistryKeyDWORDValueExists(ByVal lHive, ByVal strKeyPath, ByVal strValueName)
If IsEmpty(lValue) Then
CheckRegistryKeyDWORDValueExists = False
Else
CheckRegistryKeyDWORDValueExists = True
End If
End Function
End Class
'=============
' Function: CheckWow64RegistryKeyExists
' Description: Used to check existence of registry key
'
' HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node
'
' Parameters: None
' Returns: True if the registry key exists else false.
'=============
Public Function CheckWow64RegistryKeyExists()
Dim oReg
Dim bGranted
Dim strKeyPath
Dim HKEY_LOCAL_MACHINE
Dim KEY_QUERY_VALUE
ScriptContext.Echo "Checking for Wow64 registry key."
'Check access to the specified registry key
HKEY_LOCAL_MACHINE = &H80000002
strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\SMS"
KEY_QUERY_VALUE = &H1
if oReg.CheckAccess(HKEY_LOCAL_MACHINE, strKeyPath, KEY_QUERY_VALUE, bGranted) = 0 Then
ScriptContext.Echo "Wow64 is present on this computer; found registry key : " + strKeyPath
CheckWow64RegistryKeyExists = bGranted
Else
ScriptContext.Echo "Wow64 is not present on this computer; could not access registry key : " + strKeyPath
CheckWow64RegistryKeyExists = False
End If
Set oReg = Nothing
End Function
'=============
' Function: WMIGetObject
' Description: Returns an object of type SWbemObjectSet
' Parameters:
' sNamespace - A WMI Namespace (ex. winmgmts:\\COMPUTERNAME\ROOT\cimv2).
'=============
Function WMIGetObject(sNamespace)
Dim oWMI
Dim nErrNumber, sErrDescription
On Error Resume Next
Set oWMI = GetObject(sNamespace)
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If IsEmpty(oWMI) Or nErrNumber <> 0 Then
ScriptContext.Echo "Unable to open WMI Namespace " & sNamespace
Err.Raise 9100, GET_WMI_NO_NAMESPACE_SOURCE(sNamespace), GET_WMI_NO_NAMESPACE_DESCRIPTION(nErrNumber, sErrDescription)
End If
Set WMIGetObject = oWMI
Set oWMI = Nothing
End Function
'=============
' Function: WMIGetInstance
' Description: Returns an object of type SWbemObjectSet
' Parameters:
' sNamespace - A WMI Namespace (ex. winmgmts:\\COMPUTERNAME\ROOT\cimv2).
' sInstance - A WMI Namespace Instance (ex. Win32_OperatingSystem)
'=============
Function WMIGetInstance(sNamespace, sInstance)
Dim oWMI, oInstance
Dim nErrNumber, sErrDescription
On Error Resume Next
Set oWMI = GetObject(sNamespace)
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If IsEmpty(oWMI) Or nErrNumber <> 0 Then
ScriptContext.Echo "Unable to open WMI Namespace " & sNamespace
Err.Raise 9100, GET_WMI_NO_NAMESPACE_SOURCE(sNamespace), GET_WMI_NO_NAMESPACE_DESCRIPTION(nErrNumber, sErrDescription)
End If
On Error Resume Next
Set oInstance = oWMI.InstancesOf(sInstance)
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If IsEmpty(oInstance) Or nErrNumber <> 0 Then
ScriptContext.Echo "The class name '" & sInstance & "' returned no instances. Error:" & nErrNumber & ", " & sErrDescription & "."
Err.Raise 9100, GET_WMI_NO_INSTANCES_SOURCE(sInstance), GET_WMI_NO_INSTANCES_DESCRIPTION(nErrNumber, sErrDescription)
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
Dim nInstanceCount
nInstanceCount = oInstance.Count
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If nErrNumber <> 0 Then
ScriptContext.Echo "The class name '" & sInstance & "' did not return any valid instances. Error:" & nErrNumber & ", " & sErrDescription & "."
Err.Raise 9100, GET_WMI_NO_VALID_INSTANCES_SOURCE(sInstance), GET_WMI_NO_VALID_INSTANCES_DESCRIPTION(nErrNumber, sErrDescription)
End If
Set WMIGetInstance = oInstance
Set oInstance = Nothing
Set oWMI = Nothing
End Function
'=============
' Function: WMIExecQuery
' Description: Returns an object of type SWbemObjectSet
' Parameters:
' sNamespace - A WMI Namespace (ex. winmgmts:\\COMPUTERNAME\ROOT\cimv2).
' sQuery - A SQL Query (ex. SELECT * FROM Win32_OperatingSystem)
'=============
Function WMIExecQuery(sNamespace, sQuery)
Dim oWMI, oQuery
Dim nErrNumber, sErrDescription
On Error Resume Next
Set oWMI = GetObject(sNamespace)
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If IsEmpty(oWMI) Or nErrNumber <> 0 Then
ScriptContext.Echo "Unable to open WMI Namespace " & sNamespace
Err.Raise 9100, GET_WMI_NO_NAMESPACE_SOURCE(sNamespace), GET_WMI_NO_NAMESPACE_DESCRIPTION(nErrNumber, sErrDescription)
End If
On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If IsEmpty(oQuery) Or nErrNumber <> 0 Then
ScriptContext.Echo "The Query '" & sQuery & "' returned an invalid result set. Error:" & nErrNumber & ", " & sErrDescription & "."
Err.Raise 9100, GET_WMI_QUERY_NO_RESULTS_SOURCE(sQuery), GET_WMI_QUERY_NO_RESULTS_DESCRIPTION(nErrNumber, sErrDescription)
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
Dim nInstanceCount
nInstanceCount = oQuery.Count
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If nErrNumber <> 0 Then
ScriptContext.Echo "The Query '" & sQuery & "' did not return any valid instances. Error:" & nErrNumber & ", " & sErrDescription & "."
Err.Raise 9100, GET_WMI_QUERY_NO_VALID_INSTANCES_SOURCE(sQuery), GET_WMI_QUERY_NO_VALID_INSTANCES_DESCRIPTION(nErrNumber, sErrDescription)
End If
Set WMIExecQuery = oQuery
Set oQuery = Nothing
Set oWMI = Nothing
End Function
'******************************************************************************
' Name: IsEventTracingEnabled
'
' Purpose: Returns the state of the EventTracingEnabled registry setting.
' This setting is directs scripts raise additional tracing MOM
' events i.e. start and completion events.
'
' Checks for the EventTracingEnabled registry value under the
' following registry paths. If the DWORD values exists, it is read.
'
' HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft Operations Manager
' HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft Operations Manager
'
' Parameters: None
'
' Returns: True if the value exists and is set to 1 else False.
'
Function IsEventTracingEnabled()
Home
Show References: