Attribute VB_Name = "mod_Quit"


Option Explicit

' ------------------------- DECLARATIONS -------------------------

' Notwendige Typdeklarationen

Private Type LUID
  UsedPart As Long
  IgnoredForNowHigh32BitPart As Long
End Type

Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  TheLuid As LUID
  Attributes As Long
End Type

Public Type OSVERSIONINFO '
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long           '1 = Windows 95/98
                                  '2 = Windows NT
   szCSDVersion As String * 128
End Type



Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const EWX_POWEROFF = 8

Private Const EWX_FORCEIFHUNG = 16

Private Const VER_PLATFORM_WIN32_NT = 2

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF


Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
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
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Integer

Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Public Enum ShutdownActions
  ShutDown = 1
  Reboot = 2
  LogOff = 4
  PowerOff = 8
End Enum

Public Enum ForceModes
  NoForce = 0
  Force = 1
  ForceIfHung_Win2K = 2
End Enum

' ------------------------- CODE -------------------------


Public Sub ExitWindowsSession(ByVal Action As ShutdownActions, _
                              Optional ByVal ForceMode As ForceModes = NoForce)
Dim ShutdownFlags As Long

  If IsWindowsNT() Then SetShutdownPrivilege

  Select Case Action
    Case ShutDown
      ShutdownFlags = EWX_SHUTDOWN
    Case Reboot
      ShutdownFlags = EWX_SHUTDOWN + EWX_REBOOT
    Case LogOff
      ShutdownFlags = EWX_LOGOFF
    Case PowerOff
      ShutdownFlags = EWX_SHUTDOWN + EWX_POWEROFF
  End Select


  If ForceMode = ForceIfHung_Win2K And Not IsWindows2000() Then ForceMode = Force


  If ForceMode = Force Then ShutdownFlags = ShutdownFlags + EWX_FORCE


  If ForceMode = ForceIfHung_Win2K Then ShutdownFlags = ShutdownFlags + EWX_FORCEIFHUNG

  If Not IsWindowsNT() _
     And Action = LogOff _
     And ForceMode = Force Then TerminateExplorer


  ExitWindowsEx ShutdownFlags, &HFFFF
  
End Sub


Private Sub SetShutdownPrivilege()
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Dim hProcessHandle As Long
Dim hTokenHandle As Long
Dim PrivLUID As LUID
Dim TokenPriv As TOKEN_PRIVILEGES
Dim tkpDummy As TOKEN_PRIVILEGES
Dim lDummy As Long
  

  hProcessHandle = GetCurrentProcess()
  

  OpenProcessToken hProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
    TOKEN_QUERY), hTokenHandle
    

  LookupPrivilegeValue "", "SeShutdownPrivilege", PrivLUID
  

  With TokenPriv
    .PrivilegeCount = 1 ' Anzahl der Privilegien
    .TheLuid = PrivLUID ' LUID-Struktur für das Privileg
    .Attributes = SE_PRIVILEGE_ENABLED ' Das Privileg soll gesetzt werden
  End With
  
  ' Jetzt wird das Token für diesen Prozess gesetzt, um unserem Prozess
  ' das Recht für ein Herunterfahren / einen Neustart zuzuteilen:
  AdjustTokenPrivileges hTokenHandle, False, TokenPriv, _
    Len(tkpDummy), tkpDummy, lDummy
    
End Sub


Private Sub TerminateExplorer()
Dim ProcessIDExplorer As Long
Dim hProcessExplorer As Long
Dim hDesktopWindow As Long


  hDesktopWindow = GetDesktopWindow()
  

  GetWindowThreadProcessId hDesktopWindow, ProcessIDExplorer
  

  hProcessExplorer = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessIDExplorer)


  TerminateProcess hProcessExplorer, 1&
  

  CloseHandle hProcessExplorer

End Sub


Private Function IsWindowsNT() As Boolean

Dim OSInfo As OSVERSIONINFO

  With OSInfo
    .dwOSVersionInfoSize = Len(OSInfo)
    .szCSDVersion = Space$(128)
    GetVersionEx OSInfo
    IsWindowsNT = (.dwPlatformId = VER_PLATFORM_WIN32_NT)
  End With
  
End Function

Private Function IsWindows2000() As Boolean

Dim OSInfo As OSVERSIONINFO

  With OSInfo
    .dwOSVersionInfoSize = Len(OSInfo)
    .szCSDVersion = Space$(128)
    GetVersionEx OSInfo
    IsWindows2000 = (.dwPlatformId = VER_PLATFORM_WIN32_NT And .dwMajorVersion > 4)
  End With
  
End Function



