Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
VB_System_StandBy.mod
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 28.02.2009 16:08:05 |
Attribute VB_Name = "System_Standby_Mod"
Option Explicit
Private Const ES_CONTINUOUS As Long = &H80000000
Private Const ES_DISPLAY_REQUIRED As Long = &H2
Private Const ES_SYSTEM_REQUIRED As Long = &H1
Private Const ES_USER_PRESENT As Long = &H4
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const SE_SHUTDOWN_NAME As String = "SeShutdownPrivilege"
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Type FILETIME
lngLowDateTime As Long
lngHighDateTime As Long
End 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
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges As LUID_AND_ATTRIBUTES
End Type
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, ByRef NewState As TOKEN_PRIVILEGES, ByRef BufferLength As Any, ByRef PreviousState As Any, ByRef ReturnLength As Any) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function CancelWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long) As Long
Private Declare Function CreateWaitableTimer Lib "kernel32.dll" Alias "CreateWaitableTimerA" (ByVal lpTimerAttributes As Long, ByVal bManualReset As Long, ByVal lpTimerName As String) 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
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetSuspendState Lib "Powrprof.dll" (ByVal Hibernate As Long, ByVal ForceCritical As Long, ByVal DisableWakeEvent As Long) As Long
Private Declare Function SetSystemPowerState Lib "kernel32.dll" (ByVal fSuspend As Long, ByVal bForce As Boolean) As Long
Private Declare Function IsPwrHibernateAllowed Lib "Powrprof.dll" () As Long
Private Declare Sub SetThreadExecutionState Lib "kernel32.dll" (ByVal esFlags As Long)
Private Function IsWinNT() As Boolean
On Error Resume Next
Dim OS_VERSIONINFO As OSVERSIONINFO
OS_VERSIONINFO.dwOSVersionInfoSize = Len(OS_VERSIONINFO)
GetVersionEx OS_VERSIONINFO
If OS_VERSIONINFO.dwPlatformId = VER_PLATFORM_WIN32_NT Then IsWinNT = True
End Function
Private Function EnablePrivilegeNT(ByVal EnablePrivilege As Boolean) As Boolean
On Error Resume Next
Dim hToken As Long
Dim SE_SHUTDOWN_LI As LUID
Dim tokenpriv As TOKEN_PRIVILEGES
If OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken) <> 0 Then
If LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, SE_SHUTDOWN_LI) <> 0 Then
tokenpriv.PrivilegeCount = 1
If EnablePrivilege Then
tokenpriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
Else: tokenpriv.Privileges.Attributes = 0
End If
tokenpriv.Privileges.pLuid.highpart = SE_SHUTDOWN_LI.highpart
tokenpriv.Privileges.pLuid.lowpart = SE_SHUTDOWN_LI.lowpart
If AdjustTokenPrivileges(hToken, 0, tokenpriv, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then
EnablePrivilegeNT = True
End If
End If
End If
End Function
Public Sub System_GoStandBy_Timed(ByVal Sec As Long, Optional ByVal Standby As Boolean = False)
On Error Resume Next
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim tFILETIME As FILETIME
Dim hTimer As Long
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)
hTimer = CreateWaitableTimer(0, True, vbNullChar)
Call CancelWaitableTimer(hTimer)
Call SetWaitableTimer(hTimer, tFILETIME, 0, 0, 0, True)
System_GoStandBy Standby
Call CloseHandle(hTimer)
End Sub
Public Function System_GoStandBy(V_Standby As Boolean)
On Error Resume Next
If CBool(IsPwrHibernateAllowed) Then
If V_Standby Then
If IsWinNT Then Call EnablePrivilegeNT(True)
Call SetSystemPowerState(1, True)
If IsWinNT Then Call EnablePrivilegeNT(False)
Else
If IsWinNT Then Call EnablePrivilegeNT(True)
Call SetSystemPowerState(0, True)
If IsWinNT Then Call EnablePrivilegeNT(False)
End If
Else
If IsWinNT Then Call EnablePrivilegeNT(True)
Call SetSystemPowerState(1, True)
If IsWinNT Then Call EnablePrivilegeNT(False)
End If
Call SetThreadExecutionState(ES_SYSTEM_REQUIRED Or ES_CONTINUOUS Or ES_DISPLAY_REQUIRED)
End Function
Public Function System_Monitor_State(V_PowerOn As Boolean)
On Error Resume Next
If V_PowerOn = False Then
SendMessage Form1.hwnd, &H112, &HF170, ByVal 2
Else: SendMessage Form1.hwnd, &H112, &HF170, ByVal -1
End If
End Function