Выключение компа.

[andrey_manatin]

Подскажите как из Vb вырубить комп. Не спрашивая пользователя ни о чем?

[Oxygen]

В поиск по ExitWindowsEX.

[AntonGV]

Код: Выделить всё

'In a module
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
'Detect if the program is running under Windows NT
Public Function IsWinNT() As Boolean
    Dim myOS As OSVERSIONINFO
    myOS.dwOSVersionInfoSize = Len(myOS)
    GetVersionEx myOS
    IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
'set the shut down privilege for the current application
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
    ' enable shutdown privilege for the current application
    AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
' Shut Down 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
'Restart 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
'Log off the current user
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

'In a form
'This project needs a form with three command buttons
Private Sub Command1_Click()
    LogOffNT True
End Sub
Private Sub Command2_Click()
    RebootNT True
End Sub
Private Sub Command3_Click()
    ShutDownNT True
End Sub
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Command1.Caption = "Log Off NT"
    Command2.Caption = "Reboot NT"
    Command3.Caption = "Shutdown NT"
End Sub

[Oxygen]

Так... В виду частого задавания этого вопроса, предлагаю, добавить его в FAQ.

[andrey_manatin]

Спасибо всем за помощь.

[Saturn.65]

Dim strComputer As String
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate, _
(Shutdown)}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery( _
"Select * from Win32_OperatingSystem")
For Each ObjOperatingSystem In colOperatingSystems
ObjOperatingSystem.Reboot ' Для перезагрузки
Next




Dim strComputer As String

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery( _
"Select * from Win32_OperatingSystem")

For Each ObjOperatingSystem In colOperatingSystems

ObjOperatingSystem.ShutDown 'Для выключения

Next

Пробовал. Работает и ничего не спрашивает.

[inf]

в Windows XP перед вызовом функции процессу нужно получить специальную привилегию, иначе вызов функции завершается неудачей. Это касается перезагрузки и выключения, для завершения только сеанса никаких привилегий не требуется.

Код: Выделить всё

' Код формы

Private Const ANYSIZE_ARRAY = 1
Private Type LUID
  LowPart As Long
  HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
  pLuid As LUID
  Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
' Reboot system code
Private Enum eParam
  EWX_LOGOFF = 0
  EWX_SHUTDOWN = 1
  EWX_REBOOT = 2
  EWX_FORCE = 4
End Enum
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (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 GetCurrentProcess Lib "kernel32" () As Long


Private Function ShutdownEx(ByVal fParam As eParam) As Boolean
  Dim Ret As Long
  Dim hToken As Long
  Dim Tkp As TOKEN_PRIVILEGES
  Dim TkpOld As TOKEN_PRIVILEGES
  Dim aOkReboot As Boolean
  Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"

' Для перезагрузки и выключения в Windows XP требуется
' установка процессу привилегии "SeShutdownPrivilege",
' иначе попытка выполнения этих действий завершится не удачей.
' В Win 98 установка привилегии не требуется.

  If ((fParam And EWX_SHUTDOWN) = EWX_SHUTDOWN) Or ((fParam And EWX_REBOOT) = EWX_REBOOT) Then
    If OpenProcessToken(GetCurrentProcess(), 32 Or 8, hToken) Then
      Ret = LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, Tkp.Privileges(0).pLuid)
      Tkp.PrivilegeCount = 1
      Tkp.Privileges(0).Attributes = 2
      aOkReboot = AdjustTokenPrivileges(hToken, 0, Tkp, LenB(TkpOld), TkpOld, Ret)
    End If
  End If

  ShutdownEx = (ExitWindowsEx(fParam, 0) <> 0)
End Function

Private Sub Command1_Click()
  ShutdownEx EWX_LOGOFF
End Sub

Private Sub Command2_Click()
  ShutdownEx EWX_SHUTDOWN
End Sub

Private Sub Command3_Click()
  ShutdownEx EWX_REBOOT
End Sub

Private Sub Command4_Click()
' Флаг EWX_FORCE для более "жёсткого" завершения
' работающих программ. Если флаг EWX_FORCE не используется,
' то программы, требующие сохранения ваших работ в них,
' выдают сообщения "Сохранить, не сохранить, отмена", и
' если кликнуть "отмена", то такая программа вполне может
' остановить завершение сеанса (выключение, перезагрузку),
' а если вас не устраивает такое обстоятельство и Вы хотите
' потерять все не сохранённые данные, то можете передавать
' и флаг EWX_FORCE.

' Примеры:

' ShutdownEx EWX_LOGOFF or EWX_FORCE
' ShutdownEx EWX_SHUTDOWN or EWX_FORCE
' ShutdownEx EWX_REBOOT or EWX_FORCE
End Sub

Private Sub Form_Load()
  Command1.Caption = "Завершение сеанса"
  Command2.Caption = "Выключение компьютера"
  Command3.Caption = "Перезагрузка компьютера"
  Command4.Caption = "Флаг EWX_LOGOFF"
End Sub

[GSerg]

inf, то есть ты не читал этот топик перед ответом?

[inf]

Читал

[Nicky]

- Петрович, ты в армии служил?
- Ну?
- Что "Ну"?
- Ну не служил

[RayShade]

inf

Поясняю. Твой же вариант ответа, дан в топике раньше тебя, только с другой подсветкой кода.

[Гость]

Можно еще вот так:

Код: Выделить всё

Shell ("rundll32 shell32, SHExitWindowsEx 1")

[IIIypuk]

Вот вырезал из PDwizard`a (на форме кнопка с именем cmdGo и ComboBox с именем cboSys):

Код: Выделить всё

Option Explicit

'===== Functions
Private Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetCurrentProcess Lib "Kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
                              TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As _
                              String, ByVal lpName As String, lpLuid As LARGE_INTEGER) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (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

'===== Constants
Const ANYSIZE_ARRAY = 1
Const TOKEN_ADJUST_PRIVILEGES = 32
Const TOKEN_QUERY = 8
Const SE_PRIVILEGE_ENABLED As Long = 2

Const EWX_FORCE = 4
Const EWX_LOGOFF = 0
Const EWX_REBOOT = 2
Const EWX_SHUTDOWN = 1

'===== Types
Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
    pLuid As LARGE_INTEGER
    Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Type OSVERSIONINFO 'for GetVersionEx API call
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Function IsWindows95() As Boolean
    Const dwMask95 = &H1&
    IsWindows95 = (GetWinPlatform() And dwMask95)
End Function

Private Function IsWindowsNT() As Boolean
    Const dwMaskNT = &H2&
    IsWindowsNT = (GetWinPlatform() And dwMaskNT)
End Function

Private Function GetWinPlatform() As Long
    Dim osvi As OSVERSIONINFO

    osvi.dwOSVersionInfoSize = Len(osvi)
    If GetVersionEx(osvi) = 0 Then
        Exit Function
    End If
    GetWinPlatform = osvi.dwPlatformId
End Function

Private Function RebootSystem(Comm As Long) As Boolean
Dim ret As Long
Dim hToken As Long
Dim tkp As TOKEN_PRIVILEGES
Dim tkpOld As TOKEN_PRIVILEGES
Dim fOkReboot As Boolean
Const sSHUTDOWN As String = "SeShutdownPrivilege"

   'Check to see if we are running on Windows NT
   If IsWindowsNT() Then
         'We are running windows NT.  We need to do some security checks/modifications
         'to ensure we have the token that allows us to reboot.
         If OpenProcessToken(GetCurrentProcess(), _
            TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) Then
            ret = LookupPrivilegeValue(vbNullString, sSHUTDOWN, tkp.Privileges(0).pLuid)
            tkp.PrivilegeCount = 1
            tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
            fOkReboot = AdjustTokenPrivileges(hToken, 0, tkp, LenB(tkpOld), tkpOld, ret)
         End If
      Else
         'We are running Win95/98.  Nothing needs to be done.
         fOkReboot = True
   End If
   
   If fOkReboot Then RebootSystem = (ExitWindowsEx(Comm, 0) <> 0)
   
End Function

Private Sub cmdGo_Click()
Dim sType As Long

   Select Case LCase(cboSys.Text)
      Case LCase("Reboot")
         sType = EWX_REBOOT
      Case LCase("ShutDown")
         sType = EWX_SHUTDOWN
      Case LCase("Force")
         sType = EWX_FORCE
      Case LCase("Logoff")
         sType = EWX_LOGOFF
      Case Else
         Exit Sub
   End Select
   
   If Not RebootSystem(sType) Then MsgBox "Не удаётся выполнить команду", vbCritical: End
   
End Sub

Private Sub Form_Load()

   cboSys.AddItem "Reboot"
   cboSys.AddItem "ShutDown"
   cboSys.AddItem "Force"
   cboSys.AddItem "LogOff"
   cboSys.Text = "Reboot"
   
End Sub


[Lumen]

IIIурик

то есть ты не читал этот топик перед ответом?

[IIIypuk]

IIIурик

то есть ты не читал этот топик перед ответом?

Мде, пост AtnonGV пропустил...

[X-hacker]

Вот такое тут вроде не писали:

WinExec "Shutdown -s -t 00" 'Выключение
WinExec "Shutdown -a" 'Отмена выключения
WinExec "Shutdown -r" 'Restart

[keks-n]

X-hacker
И? Shutdown появился в WinXP. На более древних осях не заработает. Кстати, привелегии, для выключения компа нужны не только в XP, но и во всех NT.

[X-hacker]

Ну я думал, что под WinXP и надо выключить, ежели нет, то тут прям по ответам можно фак про выключения писать(ето, всмысле хорошо)

[Mleha]

Вот такое тут вроде не писали:

WinExec "Shutdown -s -t 00" 'Выключение
WinExec "Shutdown -a" 'Отмена выключения
WinExec "Shutdown -r" 'Restart

А Win 2003 Server

Shutdown /r
Shutdown /s
Shutdown /a

[tyomitch]

Вот такое тут вроде не писали:

WinExec "Shutdown -s -t 00" 'Выключение
WinExec "Shutdown -a" 'Отмена выключения
WinExec "Shutdown -r" 'Restart

А Win 2003 Server

Shutdown /r
Shutdown /s
Shutdown /a

А не хватает соображения догадаться, что оба этих варианта работают в обеих системах?

[NIC]

Dim strComputer As String
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate, _
(Shutdown)}!" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery( _
"Select * from Win32_OperatingSystem")
For Each ObjOperatingSystem In colOperatingSystems
ObjOperatingSystem.Reboot ' Для перезагрузки
Next




Dim strComputer As String

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate,(Shutdown)}!" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery( _
"Select * from Win32_OperatingSystem")

For Each ObjOperatingSystem In colOperatingSystems

ObjOperatingSystem.ShutDown 'Для выключения

Next

Пробовал. Работает и ничего не спрашивает.

в XP / NT отключи все службы и не заработает это уже было

[NIC]

Так... В виду частого задавания этого вопроса, предлагаю, добавить его в FAQ.

Может его в OFF TOP...