modShutdownFunctions (Rechner per VBA herunterfahren)

 

Option Compare Database
Option ExplicitPrivate Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4

Private Declare Function ExitWindowsEx _
Lib „user32“ _
(ByVal uFlags As Long, _
ByVal dwReserved As Long) _
As Long

Private Const VER_PLATFORM_WIN32_NT = 2
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx _
Lib „kernel32“ Alias „GetVersionExA“ _
(ByRef lpVersionInformation As OSVERSIONINFO) _
As Long

Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Type LUID
LowPart As Long
HighPart As Long
End Type
Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Private Declare Function GetCurrentProcess _
Lib „kernel32“ () _
As Long
Private Declare Function OpenProcessToken _
Lib „advapi32“ _
(ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) _
As Long
Private Declare Function LookupPrivilegeValue _
Lib „advapi32“ Alias „LookupPrivilegeValueA“ _
(ByVal lpSystemName As String, _
ByVal lpName As String, _
lpLuid As LUID) _
As Long
Private Declare Function AdjustTokenPrivileges _
Lib „advapi32“ _
(ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
PreviousState As TOKEN_PRIVILEGES, _
ReturnLength As Long) _
As Long

Public Sub ComputerShutdown(ShutdownMode As Long)
Dim WinInfo As OSVERSIONINFO
Dim hProcess As Long
Dim hToken As Long
Dim LocalLUID As LUID
Dim LocalPriv As TOKEN_PRIVILEGES
Dim NewPriv As TOKEN_PRIVILEGES
Dim lBuffer As Long
Dim lFlags As Long

If MsgBox(„Wollen Sie Windows wirklich beenden?“, _
vbCritical + vbYesNo, „Ende“) = vbYes Then
WinInfo.dwOSVersionInfoSize = Len(WinInfo)
GetVersionEx WinInfo
‚dwPlatformID für Win95/98/ME ist 1, für WinNT/2000/XP ist es 2
If WinInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then
hProcess = GetCurrentProcess()
OpenProcessToken hProcess, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue „“, „SeShutdownPrivilege“, LocalLUID
LocalPriv.PrivilegeCount = 1
LocalPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
LocalPriv.Privileges(0).pLuid = LocalLUID
AdjustTokenPrivileges hToken, False, LocalPriv, Len(NewPriv), NewPriv, lBuffer
End If
Select Case ShutdownMode
Case 1 ‚Logoff
lFlags = EWX_LOGOFF + EWX_FORCE
Case 2 ‚Neu starten
lFlags = EWX_REBOOT + EWX_FORCE
Case 3 ‚Herunterfahren
lFlags = EWX_SHUTDOWN + EWX_FORCE
Case Else
lFlags = EWX_SHUTDOWN + EWX_FORCE
End Select
ExitWindowsEx lFlags, 0
End If
End Sub