SMS 2003 Monitor SMS Executive Crash Dumps

SMS_2003_Monitor_SMS_Executive_Crash_Dumps (WriteActionModuleType)

Monitors SMS Executive crash dumps and reports the most recent new instance
Element properties:

Show References:
- Rules (1)
Type	WriteActionModuleType
Isolation	Any
Accessibility	Internal
RunAs	Default
InputType	System.BaseData
Comment	{402156B5-CA34-4A75-B700-C8B61CD88A6C}
Member Modules:

ID	Module Type	TypeId	RunAs
RunScriptAction	WriteAction	System.Mom.BackwardCompatibility.ScriptResponse	Default
Source Code:

<WriteActionModuleType ID="SMS_2003_Monitor_SMS_Executive_Crash_Dumps" Accessibility="Internal" Comment="{402156B5-CA34-4A75-B700-C8B61CD88A6C}">

  <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"/>

  </Configuration>

  <ModuleImplementation>

    <Composite>

      <MemberModules>

        <WriteAction ID="RunScriptAction" TypeID="MomBackwardCompatibility!System.Mom.BackwardCompatibility.ScriptResponse">

          <AlertGeneration>$Config/AlertGeneration$</AlertGeneration>

          <InvokerType>$Config/InvokerType$</InvokerType>

          <Body><Script>

'*******************************************************************************

' Script Name - SMS 2003 Monitor SMS Executive Crash Dumps

'

' Purpose     - Monitors SMS Executive crash dumps and reports the most recent

'               new instance.

'

'               1710 - An event used to report that a crash dump occurred.

'

'               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.

'               1105 - Accessed denied due to connection failure or permissions.

'

' Assumptions - This script will only run on SMS Servers based on SMS Executive.

'

'               This script does not support agentless mode and will silently

'               terminate.

'

'               If a series of crash dumps occurred since the last time this

'               script ran, only the last or most recent crash will be reported.

'

' Parameters  - None

'

' Change Hist - Date      Version          Description

'               --------  ---------------  -----------

'               08/24/04  05.0.2707.0000   Added

'

' (c) Copyright 2004, Microsoft Corp., All Rights Reserved

'*******************************************************************************



Option Explicit



'Event Severity Constants

'========================



Const EVENT_TYPE_SUCCESS     = 0

Const EVENT_TYPE_ERROR       = 1

Const EVENT_TYPE_WARNING     = 2

Const EVENT_TYPE_INFORMATION = 4



Const EVENTLOG_AUDIT_SUCCESS = 8

Const EVENTLOG_AUDIT_FAILURE = 16





'Event Number Constants

'======================



Const EVENT_ID_NOTANEVENT    = 1100

Const EVENT_ID_SCRIPTSUCCESS = 1101

Const EVENT_ID_SCRIPTERROR   = 1102

Const EVENT_ID_ACCESSDENIED  = 1105



Const EVENT_ID_SMS_EXECUTIVE_CRASH_DUMP = 1710





'Event and Log Messages Constants

'================================



'Start Localization



'End Localization





'Debug Level constants

'=====================



Const DBG_TRACE   = 1

Const DBG_WARNING = 2

Const DBG_ERROR   = 3

Const DBG_NONE    = 4





'Registry Path and Value Constants

'=================================



Const REG_KEY_IDENTIFICATION  = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\SMS\Identification\"



Const REG_VAL_INSTALLATION_DIRECTORY = "Installation Directory"

Const REG_VAL_SITE_CODE = "Site Code"





'Varset Constants

'================



Const VAR_LAST_CRASH_DUMP_FOLDER_CREATE_DATE = "LastCrashDumpCreateDate"





'Global variables

'================



Dim g_oDictionary		' Stores varset data.  Note, only string data can be stored.





'******************************************************************************

' Name:       Main

'

' Purpose:    Entry point for program execution.

'

' Parameters: None

'

' Returns:    Nothing

'

Sub Main()



    On Error Resume Next





    LogMessage DBG_TRACE, ScriptContext.Name &amp; " script starting at local time: " &amp; CStr(Time)

    

    'This script does not support agentless monitoring.

    '==================================================

    

    If ScriptContext.IsTargetAgentless Then

        LogMessage DBG_TRACE, "No action taken; agentless monitoring is not supported."

        Exit Sub

    End If

    

    'Initialize the persistent var set this script uses.

    '===================================================



    OpenVarSet



    If 0 &lt;&gt; Err.number Then

        ScriptError "load script variables." &amp; GetErrorString(Err)

        Exit Sub

    End If



    'Check if a new crash dump has occurred since the last time a check

    'was done.  If so, raise an event to report it.

    '==================================================================

    

    CheckOnNewCrashDump



    'Persist the var set this script uses.

    '=====================================



    SaveVarSet 



    If 0 &lt;&gt; Err.number Then

        ScriptError "save script variables." &amp; GetErrorString(Err)

    End If



    LogMessage DBG_TRACE, ScriptContext.Name &amp; " script completed at local time: " &amp; CStr(Time)



End Sub





'******************************************************************************

' Name:       CheckOnNewCrashDump

'

' Purpose:    Checks if a new crash dump directory has been created since the

'             last time a check was done.

'

' Parameters: None

'

' Returns:    Nothing

'

Sub CheckOnNewCrashDump()



    Dim strError



    Dim objFSO

    Dim objSubFolder

    Dim objSubFolders

    Dim objCrashDumpsFolder



    Dim strTemp

    Dim strNewFolder

    Dim strCrashDumpsPath



    Dim FolderCreateDate

    Dim NewFolderCreateDate

    Dim LastFolderCreateDate

    

    Dim intDateDiffSeconds





    On Error Resume Next





    'Construct the full path for the CrashDumps directory.

    '=====================================================



    strCrashDumpsPath = GetSMSInstallationPath()



    If IsEmpty(strCrashDumpsPath) Then

        Exit Sub

    End If

    

    strCrashDumpsPath = strCrashDumpsPath &amp; "\Logs\CrashDumps"



    'Check if the CrashDumps directory exists.

    '=========================================

    

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    

    If Not objFSO.FolderExists(strCrashDumpsPath) Then

    

        LogMessage DBG_ERROR, "Failed to verify existence of crash dump directory: " &amp; strCrashDumpsPath &amp; "."

        

        Set objFSO = Nothing

        Err.Clear

        Exit Sub

    End If



    'Get last crash dump folder creation date.

    '=========================================

    

    LastFolderCreateDate = GetLastCrashDumpFolderCreateDate()

    

    'Check if new crash dumps were created and act only on the last one.

    '===================================================================

    

    Set objCrashDumpsFolder = objFSO.GetFolder(strCrashDumpsPath)



    Set objSubFolders = objCrashDumpsFolder.SubFolders



    If objSubFolders.Count &lt;&gt; 0 Then

    

        For Each objSubFolder In objSubFolders

        

            FolderCreateDate = objSubFolder.DateCreated

            

            intDateDiffSeconds = DateDiff("s", LastFolderCreateDate, FolderCreateDate)

            

            If intDateDiffSeconds &gt; 0 Then                       

                strNewFolder = objSubFolder.Name

                NewFolderCreateDate = FolderCreateDate

            End If



        Next

        

    End If

    

    'If a new crash dump occurred, create an event.

    '==============================================

    

    If IsEmpty(strNewFolder) Then

        LogMessage DBG_TRACE, "A new crash dump was not found under " &amp; strCrashDumpsPath &amp; "."

    Else

        LogMessage DBG_TRACE, "Crash dump " &amp; strNewFolder &amp; " was found under " &amp; strCrashDumpsPath &amp; "."

        CreateCrashDumpEvent strCrashDumpsPath, strNewFolder

        SetLastCrashDumpFolderCreateDate(NewFolderCreateDate)

    End If



    'Cleanup

    '=======

    

    Set objSubFolders = Nothing

    Set objCrashDumpsFolder = Nothing

    Set objFSO = Nothing



End Sub





'******************************************************************************

' Name:       GetSMSInstallationPath

'

' Purpose:    Get the SMS Installation Directory from the registry under the

'             SMS Identification key.

'

' Parameters: None

'

' Returns:    String, SMS Installation path if successful otherwise empty.

'

Function GetSMSInstallationPath()



    Dim strError



    Dim objShell

    



    On Error Resume Next





    'Create the WSH Shell object for accessing the registry.

    '=======================================================



    Set objShell = CreateObject("WScript.Shell")



    'Read the Installation Directory value from under the SMS

    'Identification key.

    '========================================================



    GetSMSInstallationPath = objShell.RegRead(REG_KEY_IDENTIFICATION &amp; REG_VAL_INSTALLATION_DIRECTORY)

    

    If IsEmpty(GetSMSInstallationPath) Then

        strError = GetErrorString(Err)

        LogMessage DBG_ERROR, "Failed to read registry value." &amp; strError

        ScriptError "read registry value." &amp; strError

        Err.Clear

    End If



    Set objShell = Nothing



End Function





'******************************************************************************

' Name:       GetSMSSiteCode

'

' Purpose:    Get the SMS Site Code from the registry under the SMS

'             Identification key.

'

' Parameters: None

'

' Returns:    String, returns the SMS Site Code if successful otherwise empty.

'

Function GetSMSSiteCode()



    Dim strError



    Dim objShell

    



    On Error Resume Next





    'Create the WSH Shell object for accessing the registry.

    '=======================================================



    Set objShell = CreateObject("WScript.Shell")

    

    'Read the Site Code value from under the SMS Identification key.

    '===============================================================



    GetSMSSiteCode = objShell.RegRead(REG_KEY_IDENTIFICATION &amp; REG_VAL_SITE_CODE)

    

    If IsEmpty(GetSMSSiteCode) Then

        strError = GetErrorString(Err)

        LogMessage DBG_ERROR, "Failed to read registry value." &amp; strError

        ScriptError "read registry value." &amp; strError

        Err.Clear

    End If



    Set objShell = Nothing



End Function





'******************************************************************************

' Name:       CreateCrashDumpEvent

' 

' Purpose:	  To generate a MOM event containing the crash dump information

'             found from the specified crash dump folder.

'

' Parameters: strCrashDumpsPath, the full CrashDumps folder path.

'             strCrashDumpFolder, a crash dump folder under the CrashDumps

'                                 folder path.

'

' Returns:    Nothing

'

Sub CreateCrashDumpEvent(strCrashDumpsPath, strCrashDumpFolder)



    Dim oEvent

    

    Dim strSiteCode

    Dim strMessage





    On Error Resume Next





    'Create MOM event object.

    '========================



    Set oEvent = ScriptContext.CreateEvent



    'Initialize the event object.

    '============================



    oEvent.EventType   = EVENT_TYPE_ERROR

    oEvent.EventNumber = EVENT_ID_SMS_EXECUTIVE_CRASH_DUMP

    

    strSiteCode = GetSMSSiteCode()

    oEvent.Category = strSiteCode



    strMessage = "SMS Executive in site '" &amp; strSiteCode &amp; _

                 "' has crashed.  For details see crash dump information under '" &amp; _

                 strCrashDumpsPath &amp; "\" &amp; strCrashDumpFolder &amp; "'."



    oEvent.Message = strMessage



    'Submit, raise, this event to MOM.

    '=================================



    LogMessage DBG_TRACE, "Submitting event " &amp; EVENT_ID_SMS_EXECUTIVE_CRASH_DUMP &amp; "."

    

    ScriptContext.Submit oEvent



    'Cleanup

    '=======



    Set oEvent = Nothing



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

'

' Returns:    String, the description for the error.  (Includes the error code.)

'

Function GetErrorString(oErr)



    Dim lErr

    Dim strErr





    lErr = oErr

    strErr = oErr.Description



    On Error Resume Next





    If 0 &gt;= 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 = &amp;HFFFF0000  

        Const HiWord8007 = &amp;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 " &amp; (lErr And LoWordMask))



                Dim strMessage, i

                Do

                    strMessage = oExec.stdout.ReadLine()

                    i = i + 1

                Loop While (Len(strMessage) = 0) And (i &lt; 5)



                strErr = strMessage

                

            End If

            

        End If

        

    End If



    GetErrorString = vbCrLf &amp; "The error returned was: '" &amp; strErr &amp; "' " &amp; lErr &amp; " (0x" &amp; Hex(lErr) &amp; ")"



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." &amp; vbCrLf &amp; "Failed to " &amp; 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)



    Dim oEvent





    On Error Resume Next



    Set oEvent = ScriptContext.CreateEvent



    oEvent.EventNumber = lEventID

    oEvent.EventType = lEventType

    oEvent.Message = "The script '" &amp; ScriptContext.Name &amp; "' running under processing rule '" &amp; ScriptContext.ProcessingRule.Name &amp; "' " &amp; strMessage



    ScriptContext.Submit oEvent

      

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 &lt; 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





'******************************************************************************

' Name:       OpenVarSet

' 

' Purpose:    Opens a varset file and reads the data from it, into g_oDictionary.

'             Only one varset can be open at a single time.  Opening a second

'             varset will remove the first one.  If the first one has not

'             been saved then the changes will be lost.

'

' Parameters: None

'

' Returns:    Nothing

'

Sub OpenVarSet()



    Dim oFSO

    Dim oTempFolder

    Dim oFile





    Set g_oDictionary = CreateObject("Scripting.Dictionary")



    Set oFSO = CreateObject("Scripting.FileSystemObject")

    

    If 0 &lt;&gt; Err Then

        ScriptError "create Scripting.FileSystemObject." &amp; GetErrorString(Err)

    Else

    

        Set oTempFolder = oFSO.GetSpecialFolder(2)

        

        If 0 &lt;&gt; Err Then

            ScriptError "find the Temp directory." &amp; GetErrorString(Err)

        Else

        

            Set oFile = oFSO.OpenTextFile(oTempFolder.Path &amp; "\" &amp; ScriptContext.Name &amp; ".VarSet", 1, True, -1)

            

            If 0 &lt;&gt; Err Then

                ScriptError "open the '" &amp; ScriptContext.Name &amp; ".VarSet' file in the Temp directory." &amp; GetErrorString(Err)

            Else

            

                Do Until oFile.AtEndOfStream

                

                    Dim strLine, iBreak

                    

                    strLine = oFile.ReadLine()

                    iBreak = Instr(strLine, vbTab)

                    g_oDictionary.Add Left(strLine, iBreak - 1), Mid(strLine, iBreak + 1)

                    

                Loop

            

            oFile.Close

            

            End If

            

        End If

    

    End If

    

End Sub





'******************************************************************************

' Name:       SaveVarSet

' 

' Purpose:    Persistently stores the varset on disk, uses the temp directory.

'

' Parameters: None

'

' Returns:    Nothing

'

Sub SaveVarSet()



    Dim oFSO

    Dim oTempFolder

    Dim oFile





    Set oFSO = CreateObject("Scripting.FileSystemObject")

    

    If 0 &lt;&gt; Err Then

        ScriptError "create Scripting.FileSystemObject." &amp; GetErrorString(Err)

    Else

    

        Set oTempFolder = oFSO.GetSpecialFolder(2)

        

        If 0 &lt;&gt; Err Then

            ScriptError "find the Temp directory." &amp; GetErrorString(Err)

        Else

        

            Set oFile = oFSO.CreateTextFile(oTempFolder.Path &amp; "\" &amp; ScriptContext.Name &amp; ".VarSet", True, True)

            

            If 0 &lt;&gt; Err Then

                ScriptError "create the '" &amp; ScriptContext.Name &amp; ".VarSet' file in the Temp directory." &amp; GetErrorString(Err)

            Else

            

                Dim aKeys, aItems, lIndex

                

                aKeys = g_oDictionary.Keys

                aItems = g_oDictionary.Items

                

                For lIndex = 0 to g_oDictionary.Count - 1

                    oFile.WriteLine aKeys(lIndex) &amp; vbTab &amp; aItems(lIndex)

                Next



            oFile.Close

            

            End If

            

        End If

        

    End If



    Set g_oDictionary = nothing



End Sub





'******************************************************************************

' Name:       GetData

' 

' Purpose:    Retrieves data out of a varset.  Uses the key to determine what

'             data to retrieve.

'

' Parameters: strKey, the key of the data to retrieve

'

' Returns:    String, the data to return or an empty string

'

Function GetData(strKey)



    If g_oDictionary.Exists(strKey) Then

        GetData = g_oDictionary.Item(strKey)

    Else

        GetData = Empty

    End If



End Function





'******************************************************************************

' Name:       SetData

' 

' 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.

'

' Parameters: strKey, the key of the line to replace

'             Data, the data to associate with the key

'

' Returns:    Nothing

'

Sub SetData(strKey, Data)



    g_oDictionary.Item(strKey) = Data



End Sub





'******************************************************************************

' Name:       GetLastCrashDumpFolderCreateDate

'

' Purpose:    Retrieves previously saved crash dump folder creation date out of

'             a varset.

'

' Parameters: None

'

' Returns:    String, the data to return or zero

'

Function GetLastCrashDumpFolderCreateDate()



    GetLastCrashDumpFolderCreateDate = GetData(VAR_LAST_CRASH_DUMP_FOLDER_CREATE_DATE)



End Function





'******************************************************************************

' Name:       SetLastCrashDumpFolderCreateDate

'

' Purpose:    Saves the specified crash dump folder creation date 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: Date, the crash dump folder creation date to save

'

' Returns:    Nothing

'

Sub SetLastCrashDumpFolderCreateDate(Date)



    SetData VAR_LAST_CRASH_DUMP_FOLDER_CREATE_DATE, Date



End Sub</Script></Body>

          <Language>VBScript</Language>

          <Name>SMS 2003 Monitor SMS Executive Crash Dumps</Name>

          <Parameters/>

          <ManagementPackId>[Microsoft.SMS.2003,,1.0.0.1]</ManagementPackId>

        </WriteAction>

      </MemberModules>

      <Composition>

        <Node ID="RunScriptAction"/>

      </Composition>

    </Composite>

  </ModuleImplementation>

  <InputType>SystemLibrary!System.BaseData</InputType>

</WriteActionModuleType>