Option Explicit

' Optionen zum Herunterfahren:
Const EWX_LogOff As Long = 0
Const EWX_SHUTDOWN As Long = 1
Const EWX_REBOOT As Long = 2

' Zusatz-Optionen:
Const EWX_FORCE As Long = 4
Const EWX_POWEROFF As Long = 8

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2

Private Type LUID
    UsedPart As Long
    IgnoredForNowHigh32BitPart As Long
End Type
 
Private Type LUID_AND_ATTRIBUTES
    TheLuid As LUID
    Attributes As Long
End Type
 
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    TheLuid As LUID
    Attributes As Long
End Type

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
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Public Function ExitWindows(Optional ByVal mode As Long = 9) As String
    Dim lngVersion As Long
    Dim fehler As String
    
    ' Windows-Version herausfinden:
    lngVersion = GetVersion()
    If ((lngVersion And &H80000000) = 0) Then
        If (mode And 8) Or (mode And 2) Or (mode And 1) Then
            ' NT, also Sicherheitsberechtigung ntig:
            fehler = AdjustToken
        End If
    End If
    
    ' Windows herunterfahren und Fehler melden:
    If Not ExitWindowsEx(mode, 0&) Then
        ExitWindows = fehler & GetLastError
    End If
End Function

Private Function AdjustToken()
    ' Sicherheitsberechtigung setzen:
    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle As Long
    Dim tmpLuid As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
    Dim fehler As String
    
    SetLastError 0
    
    ' Zugriff auf aktuellen Prozess:
    hdlProcessHandle = GetCurrentProcess()
    If GetLastError <> 0 Then
        fehler = fehler & GetLastError
    End If
 
    ' Token ffnen:
    OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
    If GetLastError <> 0 Then
        fehler = fehler & GetLastError
    End If
    
    ' Berechtigung verfgbar?
    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
    If GetLastError <> 0 Then
        fehler = fehler & GetLastError
    End If
    tkp.PrivilegeCount = 1
    tkp.TheLuid = tmpLuid
    tkp.Attributes = SE_PRIVILEGE_ENABLED
    
    ' Berechtigung aktivieren:
    AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
    If GetLastError <> 0 Then
        fehler = fehler & GetLastError
    End If
    AdjustToken = fehler
End Function

