' В модуле

Private Const EWX_LOGOFF = 0

Private Const EWX_SHUTDOWN = 1

Private Const EWX_REBOOT = 2

Private Const EWX_FORCE = 4

Private Const TOKEN_ADJUST_PRIVILEGES = &H20

Private Const TOKEN_QUERY = &H8

Private Const SE_PRIVILEGE_ENABLED = &H2

Private Const ANYSIZE_ARRAY = 1

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

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

Private Declare Function ExitWindowsEx Lib "user32" _

(ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" _

Alias "GetVersionExA" (ByRef lpVersionInformation As _

OSVERSIONINFO) As Long

' Проверить, если программа запущена под WindowsNT

Public Function IsWinNT() As Boolean

Dim myOS As OSVERSIONINFO

myOS.dwOSVersionInfoSize = Len(myOS)

GetVersionEx myOS

IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)

End Function

' Устанавливает разрешение на выключение компьютера этой программой

Private Sub EnableShutDown()

Dim hProc As Long

Dim hToken As Long

Dim mLUID As LUID

Dim mPriv As TOKEN_PRIVILEGES

Dim mNewPriv As TOKEN_PRIVILEGES

hProc = GetCurrentProcess()

OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken

LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID

mPriv.PrivilegeCount = 1

mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

mPriv.Privileges(0).pLuid = mLUID

AdjustTokenPrivileges hToken, False, mPriv, _

4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + _

(12 * mNewPriv.PrivilegeCount)

End Sub

' Выключение NT

Public Sub ShutDownNT(Force As Boolean)

Dim ret As Long

Dim Flags As Long

Flags = EWX_SHUTDOWN

If Force Then Flags = Flags + EWX_FORCE

If IsWinNT Then EnableShutDown

ExitWindowsEx Flags, 0

End Sub

' Перезагрузка NT

Public Sub RebootNT(Force As Boolean)

Dim ret As Long

Dim Flags As Long

Flags = EWX_REBOOT

If Force Then Flags = Flags + EWX_FORCE

If IsWinNT Then EnableShutDown

ExitWindowsEx Flags, 0

End Sub

' Завершение текущего сеанса

Public Sub LogOffNT(Force As Boolean)

Dim ret As Long

Dim Flags As Long

Flags = EWX_LOGOFF

If Force Then Flags = Flags + EWX_FORCE

ExitWindowsEx Flags, 0

End Sub