Dienstag, 7. Juni 2011

Room for improvements...

Nachdem ich häufiger feststellen musste, dass der PC nach dem Aufwachen aus dem Standby nicht - wie erwartet - die frisch aufgestartete Media Center präsentierte, sondern lediglich den leeren Desktop, begab ich mich auf die Suche nach der Ursache. Entweder "vergaß" das Skript sich zu merken, ob beim Übergang in den Standby MC aktiv war, oder ein anderes Ereignis führte zum temporären Aufwachen des PCs ohne MC zu starten und überschrieb beim Wiedereinschlafen den Merker.
Ich ergäntze daher das Skript um eine Log-Funktion, die die Power Management Ereignisse protokollierte und fand heraus, dass tatsächlich gelegentlich ein "Automatic Resume from Standby" auftrat, der im Skript nicht abgefangen wurde (und somit nicht zu einem Neustart von MC führte) und was dazu führte, dass der Merker, ob MC vor dem Standby aktiv war, beim timergesteuerten Wiedereinschalten des PC auf Null gesetzt wurde.

Die neue Version des Skripts unterscheidet nun das automatischen und manuelle Aufwecken des PCs und setzt entsprechend den Merker nur für den zweiten Fall. Außerdem habe ich das Skript so angepasst, dass Sprachausgaben über Stringvariablen "lokalisiert" werden können und das Program ehshell.exe kann prinzipiell gegen jedes beliebige andere Programm durch Setzen der programmspezifischen Parameter ausgetauscht werden, so dass das Skript ggf. einen universelleren Einsatz findet.

Das Skript wird bei mir aus dem Autostart Ordner aufgerufen. Durch Übergabe des Parameters "-L" wird die Logging-Funktion aktiviert. Die Log-Datei liegt im Skript-Verzeichnis und wird bei jedem Neustart überschrieben.


Skript StdbyMon.vbs:

Option Explicit

'Power Management Events
Const cntPMEventEnteringSuspend = 4
Const cntPMEventResumefromSuspend = 7
Const cntPMEventPowerStatusChange = 10
Const cntPMEventOEMEvent = 11
Const cntPMEventResumeAutomatic = 18

Dim wmiPowerManagementEvent
Dim objProcess, colProcesses
Dim objShell, wshShell, objArgs
Dim objFSO, objLogFile

Dim intEventType
Dim intLastResumeEvent : intLastResumeEvent = 0

Dim boolProgRestartOnResume : boolProgRestartOnResume = False
Dim boolProgAutostart : boolProgAutostart = False

'Logging
Dim boolLogging : boolLogging = False

Dim strRegKey, strLogFilename, strMSG
Dim strComputer : strComputer = "."

'Localization
Dim strVBSRunning : strVBSRunning = " Another instance of the script is running!"
Dim strErrProcess : strErrProcess = " Processing error! Error no. "
Dim strErrInitial : strErrInitial = " Initialization error! Error no. "
Dim strEventUnspec : strEventUnspec = " Unspecified power management event: "
Dim strEventResAuto : strEventResAuto = " Power management event: ResumeAutomatic"
Dim strEventResSusp : strEventResSusp = " Power management event: ResumeFromSuspend"
Dim strEventEntSusp : strEventEntSusp = " Power management event: EnteringSuspend"
Dim strTermProg : strTermProg = " Terminating process: "
Dim strRestartProg : strRestartProg = " Restarting process: "
Dim strScriptStarted : strScriptStarted = " Script started"

'Program Specific Data
Dim strWinRunName : strWinRunName = "Windows Media Center"
Dim strProgFolder : strProgFolder = "\ehome"
'Dim strProgHomeDir : strProgHomeDir = "%ProgramFiles%"
Dim strProgHomeDir : strProgHomeDir = "%WINDIR%"
Dim strProgName : strProgName = "ehshell.exe"

On Error Resume Next

If CountRunningVBS( WScript.ScriptFullName ) > 1 Then
    MsgBox strVBSRunning, , WScript.ScriptName
    WScript.Quit
End If

Set objArgs = WScript.Arguments

If objArgs.Count > 0 Then
    If LCase(objArgs(0)) = "-l" Then
        boolLogging = True
    End If
End If

Set wshShell = CreateObject ("WScript.Shell")

'Check registry if program is started with windows
'strRegKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\" & strWinRunName
'wshShell.RegRead(strRegKey)

'If Err = 0 Then
'    boolProgAutostart = True
'End If

'Err.Clear


strLogFilename = Left(WScript.ScriptName, Len(WScript.ScriptName)-4) & ".log"

If boolLogging = True Then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objLogFile = objFSO.CreateTextFile(strLogFilename, True)

    strMSG = Now() & strScriptStarted & vbCrLf
    objLogFile.Write strMSG
End If

strProgFolder = wshShell.ExpandEnvironmentStrings(strProgHomeDir) & strProgFolder

Set wmiPowerManagementEvent = GetObject("winmgmts:").ExecNotificationQuery("Select * from Win32_PowerManagementEvent")

If Err = 0 Then
    Do
        intEventType = wmiPowerManagementEvent.NextEvent.EventType

        Select Case intEventType

        Case cntPMEventResumeAutomatic

            strMSG = Now() & strEventResAuto & vbCrLf
            intLastResumeEvent = cntPMEventResumeAutomatic

        Case cntPMEventResumefromSuspend

            strMSG = Now() & strEventResSusp & vbCrLf
            intLastResumeEvent = cntPMEventResumefromSuspend

            If boolProgRestartOnResume = True Then
                strMSG = strMSG & Now() & strRestartProg & strProgName & vbCrLf
                WScript.Sleep 3000
                Set objShell = CreateObject("Shell.Application")
                objShell.ShellExecute strProgName, "", strProgFolder, "open", 10
            End If

            Set objShell = Nothing

        Case cntPMEventEnteringSuspend

            strMSG = Now() & strEventEntSusp & vbCrLf

            Set colProcesses = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2").ExecQuery("select * from Win32_Process where name='" & strProgName & "'")

            If colProcesses.Count > 0 Then
                strMSG = strMSG & Now() & strTermProg & strProgName & vbCrLf
                boolProgRestartOnResume = True
            End If

            If colProcesses.Count = 0 And intLastResumeEvent = cntPMEventResumefromSuspend Then
                boolProgRestartOnResume = False
            End If

            For Each objProcess in colProcesses
                objProcess.Terminate(0)
            Next

            Set colProcesses = Nothing

        Case Else

            strMSG = Now() & strEventUnspec & intEventType & vbCrLf

        End Select

        If boolLogging = True Then
            objLogFile.Write strMSG
        End If

        If Err <> 0 Then
            Wscript.Echo Now() & strErrProcess & Err & "(" & Err.Description & ")"
            Err.Clear
        End If
    Loop
Else
    Wscript.Echo Now() & strErrInitial & Err & "(" & Err.Description & ")"
End If

If boolLogging = True Then
    objLogFile.Close
End If


Function CountRunningVBS( VBScripts )
    'On Error Resume Next

    CountRunningVBS = 0

    Const wbemFlagReturnImmediately = &h10
    Const wbemFlagForwardOnly = &h20

    Dim strComputer : strComputer = "."
    Dim colProcesses : Set colProcesses = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2").ExecQuery("SELECT * FROM Win32_Process", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
    Dim objProcess

    For Each objProcess In colProcesses
        If InStr( LCase( objProcess.CommandLine), LCase( VBScripts ) ) > 0 Then
            If InStr( LCase( objProcess.CommandLine ), "script.exe" ) > 0 Then
CountRunningVBS = CountRunningVBS + 1
            End If
        End If
    Next

    Set colProcesses = Nothing

End Function



Keine Kommentare:

Kommentar veröffentlichen