VB6重启、关闭Win2000系统（改写）

VB6重启、关闭Win2000系统
Attribute VB_Name = "mdlRebootPC"
Option Explicit

'API Calls used for RebootPC

Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const EWX_SHUTDOWN As Long = 1
Private Const EWX_FORCE    As Long = 4
Private Const EWX_POWEROFF As Long = 8
Private Const EWX_REBOOT   As Long = 2

Private Type LUID
  UsedPart As Long
  IgnoredForNowHigh32BitPart As Long
End Type

Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  TheLuid As LUID
  Attributes As Long
End Type

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

Public Sub RebootPC()
  On Local Error GoTo RebootPC_ErrorHandler
 
  Const csProcName = "RebootPC"
 
  Dim hProcessHandle As Long
  Dim hTokenHandle   As Long
  Dim tmpLuid        As LUID
  Dim tkpNew         As TOKEN_PRIVILEGES
  Dim tkpPrevious    As TOKEN_PRIVILEGES
  Dim lBufferNeeded  As Long

  hProcessHandle = GetCurrentProcess()
  Call OpenProcessToken(hProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hTokenHandle)

' Get the LUID for the shutdown privilege
  Call LookupPrivilegeValue("", "SeShutdownPrivilege", tmpLuid)

  tkpNew.PrivilegeCount = 1 ' One privilege to set
  tkpNew.TheLuid = tmpLuid
  tkpNew.Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this process.
  lBufferNeeded = 0
  Call AdjustTokenPrivileges(hTokenHandle, False, tkpNew, Len(tkpPrevious), tkpPrevious, lBufferNeeded)

' Force a Reboot (no option to save files to cancel out)
  Call ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, &HFFFF)
 
  Exit Sub
RebootPC_ErrorHandler:
  Call MsgBox("Reboot PC Error !" & vbCrLf & _
              "Error Number: " & Err.Number & vbCrLf & _
              "Error Description: " & Err.Description, vbCritical, "Warnning!")
End Sub

Public Sub ShutDownPC()
  On Local Error GoTo ErrorHandler
 
  Const csProcName = "RebootPC"
 
  Dim hProcessHandle As Long
  Dim hTokenHandle   As Long
  Dim tmpLuid        As LUID
  Dim tkpNew         As TOKEN_PRIVILEGES
  Dim tkpPrevious    As TOKEN_PRIVILEGES
  Dim lBufferNeeded  As Long

  hProcessHandle = GetCurrentProcess()
  Call OpenProcessToken(hProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hTokenHandle)

' Get the LUID for the shutdown privilege
  Call LookupPrivilegeValue("", "SeShutdownPrivilege", tmpLuid)

  tkpNew.PrivilegeCount = 1 ' One privilege to set
  tkpNew.TheLuid = tmpLuid
  tkpNew.Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this process.
  lBufferNeeded = 0
  Call AdjustTokenPrivileges(hTokenHandle, False, tkpNew, Len(tkpPrevious), tkpPrevious, lBufferNeeded)

' Force a Reboot (no option to save files to cancel out)
  Call ExitWindowsEx(EWX_FORCE Or EWX_POWEROFF, &HFFFF)
 
  Exit Sub
ErrorHandler:
  Call MsgBox("ShutDownPC Error !" & vbCrLf & _
              "Error Number: " & Err.Number & vbCrLf & _
              "Error Description: " & Err.Description, vbCritical, "Warnning!")
End Sub