VB 5/6-Tipp 0695: Rechner für bestimmte Zeitspanne schlafen legen
von Frank Schüler
Beschreibung
Das in diesem Tipp präsentierte Modul stellt eine Funktion zur Verfügung, mit der ein PC in den Suspend- oder Hibernate-Modus versetzt und nach einer einstellbaren Zeit wieder in den normalen Betriebszustand zurück geholt werden kann (sofern vom System unterstützt und aktiviert).
Der Code sollte ab Windows 98 mit Ausnahme von Windows NT 4.0 laufen.
| Schwierigkeitsgrad:
| Verwendete API-Aufrufe: CancelWaitableTimer, CloseHandle, CreateWaitableTimerA (CreateWaitableTimer), GetVersionExA (GetVersionEx), IsPwrHibernateAllowed, IsPwrSuspendAllowed, SetSuspendState, SetSystemPowerState, SetThreadExecutionState, SetWaitableTimer | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------ Anfang Projektdatei prjGoSleep.vbp ------------ '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "Command1" Option Explicit Private Sub Command1_Click() Dim eGoSleepState As GoSleepState Me.AutoRedraw = True Me.Print "Startzeit: " & CStr(Now) DoEvents ' PC für 90 Sekunden schlafen schicken eGoSleepState = GoSleep(90) Select Case eGoSleepState Case 0 Me.Print "Das System wurde wieder erfolgreich nach dem " & _ vbNewLine & "Suspend- oder Hibernate-Modus gestartet." Case 1 Me.Print "Der Suspend-Modus wird vom System nicht unterstützt " & _ vbNewLine & "oder ist nicht aktiviert." Case 2 Me.Print "Der Hibernate-Modus wird vom System nicht " & _ vbNewLine & "unterstützt oder ist nicht aktiviert." Case 3 Me.Print "Das Aufwecken aus dem Suspend-Modus wird vom System " & _ vbNewLine & "nicht unterstützt." Case 4 Me.Print "Das Aufwecken aus dem Hibernate-Modus wird vom " & _ vbNewLine & "System nicht unterstützt." Case 5 Me.Print "Der Timer, der zum Aufwecken benötigt wird " & _ vbNewLine & "(WaitableTimer), kann nicht erstellt werden." Case 6 Me.Print "Der Timer, der zum Aufwecken benötigt wird " & _ vbNewLine & "(WaitableTimer), kann nicht gestartet werden." Case 7 Me.Print "Das System konnte nicht in den Suspend-Modus " & _ vbNewLine & "versetzt werden." Case 8 Me.Print "Das System konnte nicht in den Hibernate-Modus " & _ vbNewLine & "versetzt werden." Case 9 Me.Print "Der Monitor konnte nach dem Aufwecken " & _ vbNewLine & "nicht wieder eingeschalten werden." End Select Me.Print "Endzeit: " & CStr(Now) End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '------- Anfang Modul "modWakeUp" alias modWakeUp.bas ------- Option Explicit ' ----==== GetVersionEx Const ====---- Private Const VER_PLATFORM_WIN32_NT As Long = 2& ' ----==== SetThreadExecutionState Const ====---- Private Const ES_CONTINUOUS As Long = &H80000000 Private Const ES_DISPLAY_REQUIRED As Long = &H2 Private Const ES_SYSTEM_REQUIRED As Long = &H1 ' ----==== GoSleep Enum ====---- Public Enum GoSleepState SystemResume = 0 PwrSuspendNotAllowed = 1 PwrHibernateNotAllowed = 2 WaitableTimerNotCreated = 3 WaitableTimerNotSet = 4 SystemNotSuspend = 5 SystemNotHibernate = 6 MonitorCantActivate = 7 End Enum ' ----==== GetVersionEx Type ====---- Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type ' ----==== SetWaitableTimer Type ====---- Private Type FILETIME lngLowDateTime As Long lngHighDateTime As Long End Type ' ----==== Kernel32 API Declarations ====---- Private Declare Function CancelWaitableTimer Lib "Kernel32" ( _ ByVal hTimer As Long) As Long Private Declare Function CloseHandle Lib "Kernel32" ( _ ByVal hObject As Long) As Long Private Declare Function CreateWaitableTimer Lib "Kernel32" _ Alias "CreateWaitableTimerA" ( _ ByVal lpTimerAttributes As Long, _ ByVal bManualReset As Long, _ ByVal lpTimerName As String) As Long Private Declare Function GetVersionEx Lib "Kernel32" _ Alias "GetVersionExA" ( _ ByRef lpVersionInformation As OSVERSIONINFO) As Long Private Declare Function SetSystemPowerState Lib "Kernel32" ( _ ByVal fSuspend As Long, _ ByVal bForce As Boolean) As Long Private Declare Function SetThreadExecutionState Lib "Kernel32" ( _ ByVal esFlags As Long) As Long Private Declare Function SetWaitableTimer Lib "Kernel32" ( _ ByVal hTimer As Long, _ ByRef lpDueTime As FILETIME, _ ByVal lPeriod As Long, _ ByVal pfnCompletionRoutine As Long, _ ByVal lpArgToCompletionRoutine As Long, _ ByVal fResume As Long) As Long ' ----==== Powrprof API Declarations ====---- Private Declare Function IsPwrHibernateAllowed Lib "Powrprof" () As Long Private Declare Function IsPwrSuspendAllowed Lib "Powrprof" () As Long Private Declare Function SetSuspendState Lib "Powrprof" ( _ ByVal Hibernate As Long, _ ByVal ForceCritical As Long, _ ByVal DisableWakeEvent As Long) As Long ' ------------------------------------------------------ ' Funktion : EnableMonitorAfterSleep ' Beschreibung : Einschalten des Monitors nach ' Suspend- oder Hibernate-Modus ' Übergabewert : True = Monitor ein / False = Monitor aus ' Rückgabewert : Erfolgreich = previous thread execution state ' Fehlgeschlagen = null ' ------------------------------------------------------ Private Function EnableMonitorAfterSleep(ByVal EnableMonitor As Boolean) _ As Long Dim lngFlags As Long lngFlags = ES_SYSTEM_REQUIRED Or ES_CONTINUOUS ' ist EnableMonitor = True dann If EnableMonitor Then ' Monitor nach Standby oder Ruhezustand wieder einschalten lngFlags = lngFlags Or ES_DISPLAY_REQUIRED End If EnableMonitorAfterSleep = SetThreadExecutionState(lngFlags) End Function ' ------------------------------------------------------ ' Funktion : GoSleep ' Beschreibung : Schaltet das System in den Suspend- oder ' Hibernate-Modus und weckt diesen nach einer ' bestimmten Zeitspanne wieder auf (sofern das ' vom System unterstützt und aktiviert ist) ' Übergabewert : Sec = Zeit in Sekunden bis zum aufwecken ' Suspend: True = Suspend-Mode / False = Hibernate-Mode ' SetSuspendIfHibernateNotAllowed: ' True = probiere den Suspend-Mode wenn ' Hibernate-Mode nicht funktioniert ' False = Suspend-Mode nicht probieren falls ' Hibernate-Mode nicht funktioniert ' ForceCritical: False = sanftes / True = hartes ' herrunterfahren des Systems ' EnableMonitor: True = Monitor nach aufwecken einschalten ' False = Monitor nach aufwecken nicht ' einschalten ' Rückgabewert : GoSleepState = Enum GoSleepState ' ------------------------------------------------------ Public Function GoSleep(ByVal Sec As Long, Optional ByVal Suspend As _ Boolean = True, Optional ByVal SetSuspendIfHibernateNotAllowed As _ Boolean = True, Optional ByVal ForceCritical As Boolean = False, _ Optional ByVal EnableMonitor As Boolean = True) As GoSleepState Dim dblDelay As Double Dim dblDelayLow As Double Dim dblUnits As Double Dim tFILETIME As FILETIME Dim hTimer As Long ' ---=== Suspend-Mode ===--- If Suspend Then ' wenn der Suspend-Mode nicht unterstützt wird, dann If Not CBool(IsPwrSuspendAllowed) Then ' Rückgabewert setzen GoSleep = PwrSuspendNotAllowed ' Funktion verlassen Exit Function End If Else ' ---=== Hibernate-Mode ===--- ' wenn der Hibernate-Mode nicht unterstützt wird, dann If Not CBool(IsPwrHibernateAllowed) Then ' Suspend-Mode testen wenn der Hibernate-Mode nicht ' unterstützt wird If SetSuspendIfHibernateNotAllowed Then ' wenn der Suspend-Mode nicht unterstützt wird, dann If Not CBool(IsPwrSuspendAllowed) Then ' Rückgabewert setzen GoSleep = PwrSuspendNotAllowed ' Funktion verlassen Exit Function Else ' Suspend-Mode verwenden Suspend = True End If Else ' Rückgabewert setzen GoSleep = PwrHibernateNotAllowed ' Funktion verlassen Exit Function End If End If End If ' WaitableTimer-Objekt erstellen hTimer = CreateWaitableTimer(0&, True, vbNullChar) If hTimer = 0 Then ' Rückgabewert setzen GoSleep = WaitableTimerNotCreated ' Funktion verlassen Exit Function Else dblUnits = CDbl(&H10000) * CDbl(&H10000) dblDelay = CDbl(Sec) * 1000 * 10000 tFILETIME.lngHighDateTime = -CLng(dblDelay / dblUnits) - 1 dblDelayLow = -dblUnits * (dblDelay / dblUnits - Fix(dblDelay / _ dblUnits)) If dblDelayLow < CDbl(&H80000000) Then dblDelayLow = dblUnits + dblDelayLow tFILETIME.lngHighDateTime = tFILETIME.lngHighDateTime + 1 End If tFILETIME.lngLowDateTime = CLng(dblDelayLow) ' Falls das starten des WaitableTimer fehlschlägt If SetWaitableTimer(hTimer, tFILETIME, 0&, 0&, 0&, True) = 0 Then ' WaitableTimer auf inaktiv setzen Call CancelWaitableTimer(hTimer) ' WaitableTimer-Handle schließen Call CloseHandle(hTimer) ' Rückgabewert setzen GoSleep = WaitableTimerNotSet ' Funktion verlassen Exit Function Else DoEvents ' ---=== Suspend-Mode ===--- If Suspend Then ' OS >= WinNT If IsWinNT Then ' Suspend-Mode If SetSuspendState(False, ForceCritical, False) = 0 _ Then ' Rückgabewert setzen GoSleep = SystemNotSuspend Else ' Falls das einschalten des Monitors fehlschlägt If EnableMonitorAfterSleep(EnableMonitor) = 0 _ Then GoSleep = MonitorCantActivate End If Else ' OS <= WinMe ' Suspend-Mode If SetSystemPowerState(True, ForceCritical) = 0 Then ' Rückgabewert setzen GoSleep = SystemNotSuspend Else ' Falls das einschalten des Monitors fehlschlägt If EnableMonitorAfterSleep(EnableMonitor) = 0 _ Then GoSleep = MonitorCantActivate End If End If Else ' ---=== Hibernate-Mode ===--- ' OS >= WinNT If IsWinNT Then ' Hibernate-Mode If SetSuspendState(True, ForceCritical, False) = 0 Then ' Rückgabewert setzen GoSleep = SystemNotHibernate Else ' Falls das einschalten des Monitors fehlschlägt If EnableMonitorAfterSleep(EnableMonitor) = 0 _ Then GoSleep = MonitorCantActivate End If Else ' OS <= WinMe ' Hibernate-Mode If SetSystemPowerState(False, ForceCritical) = 0 Then ' Rückgabewert setzen GoSleep = SystemNotHibernate Else ' Falls das einschalten des Monitors fehlschlägt If EnableMonitorAfterSleep(EnableMonitor) = 0 _ Then GoSleep = MonitorCantActivate End If End If End If ' WaitableTimer auf inaktiv setzen Call CancelWaitableTimer(hTimer) ' WaitableTimer-Handle schließen Call CloseHandle(hTimer) ' Rückgabewert setzen GoSleep = SystemResume End If End If End Function ' ------------------------------------------------------ ' Funktion : IsWinNT ' Beschreibung : OS-System ermitteln ' Übergabewert : keiner ' Rückgabewert : True = NT-Based System / False DOS-Based System ' ------------------------------------------------------ Private Function IsWinNT() As Boolean Dim tOSVERSIONINFO As OSVERSIONINFO tOSVERSIONINFO.dwOSVersionInfoSize = Len(tOSVERSIONINFO) Call GetVersionEx(tOSVERSIONINFO) IsWinNT = (tOSVERSIONINFO.dwPlatformId = VER_PLATFORM_WIN32_NT) End Function '-------- Ende Modul "modWakeUp" alias modWakeUp.bas -------- '------------- Ende Projektdatei prjGoSleep.vbp -------------
Tipp-Kompatibilität:
| Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
| VB4 |  | | | | | | |
| VB5 | | | | | | | |
| VB6 | | | | | |  | |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.