Когда то давно нашёл в  MSDN, проверенно что работает
(этот код выполняет restart)

Private Sub AdjustToken()
'********************************************************************
'* This procedure sets the proper privileges to allow a log off or a
'* shut down to occur under Windows NT.
'********************************************************************
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2

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
    
    'Set the error code of the last thread to zero using the
    'SetLast Error function. Do this so that the GetLastError
    'function does not return a value other than zero for no
    'apparent reason.
    SetLastError 0
   
    'Use the GetCurrentProcess function to set the hdlProcessHandle
    'variable.
    hdlProcessHandle = GetCurrentProcess()
   
    OpenProcessToken hdlProcessHandle, _
       (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
   
    'Get the LUID for shutdown privilege
    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
   
   
    tkp.PrivilegeCount = 1    ' One privilege to set
    tkp.TheLuid = tmpLuid
    tkp.Attributes = SE_PRIVILEGE_ENABLED
   
    'Enable the shutdown privilege in the access token of this process
    AdjustTokenPrivileges hdlTokenHandle, _
                          False, _
                          tkp, _
                          Len(tkpNewButIgnored), _
                          tkpNewButIgnored, _
                          lBufferNeeded
   

End Sub

Ответить

НЕРАБОТАЕТ!!!!!!!!!!

Ответить

Извини, друг, виноват.

После того как запускаешь предедущую субрутину.
Нужно запустить следующий код:
ExitWindowsEx (EWX_REBOOT Or EWX_FORCE), &HFFFF

У меня это выглядит примерно так:
If Not bIsWindows9X Then
     AdjustToken
End If
ExitWindowsEx (EWX_REBOOT Or EWX_FORCE), &HFFFF

Ответить

Спасибо, теперь могу завершать сеанс, а вто выключать нет...

Откуда взялось вот енто:

Dim tmpLuid As LUID

Dim tkp As TOKEN_PRIVILEGES

Dim tkpNewButIgnored As TOKEN_PRIVILEGES

Ответить

Когда то нашол код модуля которым пользуюсь по сей день, на Хрюшке работает, на 2000 не пробыал

Option Explicit

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000

Private Const READ_CONTROL = &H20000

Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)

Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)

Public Enum TokenRights

TOKEN_ASSIGN_PRIMARY = &H1

TOKEN_DUPLICATE = &H2

TOKEN_IMPERSONATE = &H4

TOKEN_QUERY = &H8

TOKEN_QUERY_SOURCE = &H10

TOKEN_ADJUST_PRIVILEGES = &H20

TOKEN_ADJUST_GROUPS = &H40

TOKEN_ADJUST_DEFAULT = &H80

TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)

TOKEN_READ = (STANDARD_RIGHTS_READ Or TOKEN_QUERY)

TOKEN_WRITE = (STANDARD_RIGHTS_WRITE Or TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)

TOKEN_EXECUTE = (STANDARD_RIGHTS_EXECUTE)

End Enum

Public Enum PrivilegeAttributes

SE_PRIVILEGE_ENABLED_BY_DEFAULT = &H1

SE_PRIVILEGE_ENABLED = &H2

SE_PRIVILEGE_USED_FOR_ACCESS = &H80000000

End Enum

Public Enum ExitOptions

EWX_LOGOFF = 0

EWX_SHUTDOWN = 1

EWX_REBOOT = 2

EWX_FORCE = 4

End Enum

Public Enum TokenAccess

TokenUser = 1

TokenGroups = 2

TokenPrivileges = 3

TokenOwner = 4

TokenPrimaryGroup = 5

TokenDefaultDacl = 6

TokenType = 8

TokenImpersonationLevel = 9

TokenStatistics = 10

End Enum

Type LUID

lowPart As Long

HighPart As Long

End Type

Type LUID_AND_ATTRIBUTES

pLuid As LUID

Attributes As PrivilegeAttributes

End Type

Type PTOKEN_PRIVILEGES

PrivilegeCount As Long

Privileges(0) 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 TokenRights, ByRef TokenHandle As Long) As Long

Private Declare Function LookupPrivilegeValueA Lib "advapi32" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Long

Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, ByRef NewState As PTOKEN_PRIVILEGES, ByVal BufferLength As Long, ByRef PreviousState As Long, ByRef ReturnLenght As Long) As Long

Private Declare Function AdjustTokenPrivilegesOld Lib "advapi32" Alias "AdjustTokenPrivileges" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, ByRef NewState As PTOKEN_PRIVILEGES, ByVal BufferLength As Long, ByRef PreviousState As PTOKEN_PRIVILEGES, ByRef ReturnLenght As Long) As Long

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As ExitOptions, ByVal dwReserved As Long) As Long

Public Function ShutDown(Operation As ExitOptions) As Long

Dim lngProcess As Long

Dim lngReturn As Long

Dim lngToken As Long

Dim udtLUID As LUID

Dim lngTokenPrivileges As TokenRights

Dim udtTokenPrivNew As PTOKEN_PRIVILEGES

lngProcess = GetCurrentProcess()

lngTokenPrivileges = TOKEN_ADJUST_PRIVILEGES

lngReturn = OpenProcessToken(lngProcess, lngTokenPrivileges, lngToken)

lngReturn = LookupPrivilegeValueA(vbNullString, "SE_SHUTDOWN_NAME", udtLUID)

udtTokenPrivNew.PrivilegeCount = 1

udtTokenPrivNew.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

udtTokenPrivNew.Privileges(0).pLuid = udtLUID

lngReturn = AdjustTokenPrivileges(lngToken, 0, udtTokenPrivNew, 0&, 0, 0&)

ShutDown = ExitWindowsEx(Operation, 0)

End Function

Ответить

З.Ы. Этот модуль и для блокировки Ctrl+Alt+Delete а то что тебе нужно в функции ShutDown

Ответить