Г-м... Тема не раз обсуждалась.

На вскидку, могу предложить только вот это:

  Dim OpSysSet, obj
  Set OpSysSet = GetObject("winmgmts:{impersonationLevel=impersonate," & "(Shutdown)}//./root/cimv2").ExecQuery("SELECT * FROM Win32_OperatingSystem" & " WHERE Primary=true")
  For Each obj In OpSysSet
    obj.Win32Shutdown (8)
  Next

Но это код выключения. Что-же до перезагрузки, (сам не помню -кода под рукой нет) - полазь по форуму, был здесь хороший пример.

Ответить

вот один из примеров http://www.vbnet.ru/faq/showtopic.asp?id=103

тока для выключения добавь EWX_POWEROFF = 8

Ответить

Попробовал ваши советы.

Всё равно не помогает!!!

Ответить

М-да... а у меня работает тот код, что я выложил.

Попробуй ещё вот так:

З.Ы. сам его не проверял, нашёл где-то... так что напиши чего получится.

Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
LuidUDT As LUID
Attributes As Long
End Type
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4

Private Declare Function GetVersion Lib "kernel32" () 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 Any, ReturnLength As Any) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long

Sub ShutDownWindows(ByVal Reboot As Boolean, Optional ByVal Force As Boolean)
Dim hToken As Long
Dim tp As TOKEN_PRIVILEGES
Dim flags As Long
'Windows NT/2000/XP требует специального подтверждения того,
'что вызывающий процесс имеет право на выключение или перезагрузку компьютера
If GetVersion() >= 0 Then
'Открываем процесс для установки нужных привилегий
OpenProcessToken GetCurrentProcess(), (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hToken
'Устанавливаем необходимые привилегии процесса
LookupPrivilegeValue "", "SeShutdownPrivilege", tp.LuidUDT
tp.PrivilegeCount = 1
tp.Attributes = SE_PRIVILEGE_ENABLED
AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
End If
'Подготовка к выключению
flags = EWX_SHUTDOWN
If Reboot Then flags = flags Or EWX_REBOOT
If Force Then flags = flags Or EWX_FORCE
'Выключение или перезагрузка компа
ExitWindowsEx flags, &HFFFF
End Sub

Ответить

Justas,

я немного изменил предложенный тобою код.

Вот что у меня получилось:

Private Type LUID

LowPart As Long

HighPart As Long

End Type

Private Type TOKEN_PRIVILEGES

PrivilegeCount As Long

LuidUDT As LUID

Attributes As Long

End Type

Const TOKEN_ADJUST_PRIVILEGES = &H20

Const TOKEN_QUERY = &H8

Const SE_PRIVILEGE_ENABLED = &H2

Const EWX_SHUTDOWN = 1

Const EWX_REBOOT = 2

Const EWX_FORCE = 4

Const ewx_off = 8

Private Declare Function GetVersion Lib "kernel32" () 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 Any, ReturnLength As Any) As Long

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

Function ShutDownWindows(ByVal Reboot As Boolean, Optional ByVal Force As Boolean, Optional ByVal off As Boolean)

Dim hToken As Long

Dim tp As TOKEN_PRIVILEGES

Dim flags As Long

'Windows NT/2000/XP требует специального подтверждения того,

'что вызывающий процесс имеет право на выключение или перезагрузку компьютера

If GetVersion() >= 0 Then

'Открываем процесс для установки нужных привилегий

OpenProcessToken GetCurrentProcess(), (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hToken

'Устанавливаем необходимые привилегии процесса

LookupPrivilegeValue "", "SeShutdownPrivilege", tp.LuidUDT

tp.PrivilegeCount = 1

tp.Attributes = SE_PRIVILEGE_ENABLED

AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&

End If

'Подготовка к выключению

flags = EWX_SHUTDOWN

If Reboot Then flags = flags Or EWX_REBOOT

If Force Then flags = flags Or EWX_FORCE

If off Then flags = flags Or ewx_off

'Выключение или перезагрузка компа

ExitWindowsEx flags, &HFFFF

End Function

Private Sub Command1_Click()

On Error GoTo error1

ShutDownWindows(False, True, True) = True

error1:

If Err <> 0 Then

End If

End Sub

Ответить