win2000关机

[zhogang]

用vb写要这样与他关机啊。。。。

[x8bits]

在frmMain上放置一个名为chkReboot的CHECKBOX和一个名为cmdShutdown的Command控件
然后把下面的代码放到frmMain的窗口上.

Option Explicit

Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"

Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const EWX_POWEROFF = 8
Private Const EWX_FORCEIFHUNG = 16

Private Const ANYSIZE_ARRAY = 1
Private Const ERROR_SUCCESS = 0&

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

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
Private Declare Function GetLastError Lib "kernel32" () As Long

' Shut down windows, and optional reboot it
' if the 2nd argument is True, no WM_QUERYENDSESSION and WM_ENDSESSION
' messages are sent to active applications
'
Private Function ShutDownWindows(ByVal Reboot As Boolean, Optional ByVal Force As Boolean = False)

Dim hToken As Long
Dim tkp As TOKEN_PRIVILEGES
Dim uFlags As Long
Dim dwVersion As Long
Dim dwWindowsMajorVersion As Long
Dim dwWindowsMinorVersion

' Windows NT/2000 require a special treatment
' to ensure that the calling process has the
' privileges to shut down the system

' Get the Windows version.
'
dwVersion = GetVersion()

If (dwVersion >= 0) Then ' Windows NT/2000/XP
' Get a token for this process.
' Open this process for adjusting its privileges
'
If (OpenProcessToken(GetCurrentProcess(), _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) = 0) Then
MsgBox "OpenProcessToken", vbCritical
Exit Function
End If

' Get the LUID for the shutdown privilege.
' Retrieves the locally unique identifier (LUID) used
' to locally represent the specified privilege name
' (first argument = "" means the local system)
'
If LookupPrivilegeValue("", SE_SHUTDOWN_NAME, _
tkp.Privileges(0).pLuid) = 0 Then
MsgBox "LookupPrivilegeValue", vbCritical
Exit Function
End If

' Complete the TOKEN_PRIVILEGES structure with the # of
' privileges and the desired attribute
'
tkp.PrivilegeCount = 1 ' one privilege to set
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

' Get the shutdown privilege for this process.
' Enables or disables privileges in the specified access token
' last 3 arguments are zero because we aren't interested
' in previous privilege attributes.
'
Call AdjustTokenPrivileges(hToken, False, tkp, 0, _
ByVal 0&, ByVal 0&)

' Cannot test the return value of AdjustTokenPrivileges.

If (GetLastError() <> ERROR_SUCCESS) Then
MsgBox "AdjustTokenPrivileges", vbCritical
Exit Function
End If
End If

' Prepare shutdown flags
'
uFlags = EWX_POWEROFF 'EWX_SHUTDOWN
If Reboot Then uFlags = uFlags Or EWX_REBOOT
If Force Then uFlags = uFlags Or EWX_FORCE

' Shut down the system and force all applications to close.
'
If (ExitWindowsEx(uFlags, 0) = 0) Then
Debug.Print GetLastError()
MsgBox "ExitWindowsEx", vbCritical
End If

End Function

Private Sub cmdShutdown_Click()
Call ShutDownWindows(chkReboot.Value = vbChecked, True)
End Sub