Код модуля

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

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

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

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

А в форме просто вызываешь нужную тебе функцию

ShutDownNT True

RebootNT True

LogOffNT True

Ответить

Спасибо, работает, вот только при выключении почемуто не выключается, а выкидывает табличку, что теперь комп можно выключить....

Ответить