'粘贴自http://www.mvps.org/vbnet/Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you many not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source on 
'               any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const SE_PRIVILEGE_ENABLED As Long = &H2Private Const EWX_LOGOFF As Long = &H0
Private Const EWX_SHUTDOWN As Long = &H1
Private Const EWX_REBOOT As Long = &H2
Private Const EWX_FORCE As Long = &H4
Private Const EWX_POWEROFF As Long = &H8
Private Const EWX_FORCEIFHUNG As Long = &H10 '2000/XP onlyPrivate Const VER_PLATFORM_WIN32_NT As Long = 2Private Type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
End TypePrivate Type LUID
   dwLowPart As Long
   dwHighPart As Long
End TypePrivate Type LUID_AND_ATTRIBUTES
   udtLUID As LUID
   dwAttributes As Long
End TypePrivate Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   laa As LUID_AND_ATTRIBUTES
End Type
      
Private Declare Function ExitWindowsEx Lib "user32" _
   (ByVal dwOptions As Long, _
   ByVal dwReserved As Long) As LongPrivate Declare Function GetCurrentProcess Lib "kernel32" () As LongPrivate Declare Function OpenProcessToken Lib "advapi32" _
  (ByVal ProcessHandle As Long, _
   ByVal DesiredAccess As Long, _
   TokenHandle As Long) As LongPrivate Declare Function LookupPrivilegeValue Lib "advapi32" _
   Alias "LookupPrivilegeValueA" _
  (ByVal lpSystemName As String, _
   ByVal lpName As String, _
   lpLuid As LUID) As LongPrivate 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 Long) As LongPrivate Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
  (lpVersionInformation As OSVERSIONINFO) As Long
  
  
  
Private Sub Command1_Click()   Dim uflags As Long
   Dim success As Long
   
   If Option1.Value = True Then uflags = EWX_LOGOFF
   If Option2.Value = True Then uflags = EWX_SHUTDOWN
   If Option3.Value = True Then uflags = EWX_REBOOT
   If Option4.Value = True Then uflags = EWX_POWEROFF
   
   If Check1.Value = vbChecked Then uflags = uflags Or EWX_FORCE
   If Check2.Value = vbChecked Then uflags = uflags Or EWX_FORCEIFHUNG
   
  'assume success
   success = True
  
  'if running under NT or better,
  'the shutdown privledges need to
  'be adjusted to allow the ExitWindowsEx
  'call. If the adjust call fails on a NT+
  'system, success holds False, preventing shutdown.
   If IsWinNTPlus Then
      success = EnableShutdownPrivledges()
   End If   If success Then Call ExitWindowsEx(uflags, 0&)
 
End Sub
  Private Function IsWinNTPlus() As Boolean  'returns True if running Windows NT,
  'Windows 2000, Windows XP, or .net server
   #If Win32 Then
  
      Dim OSV As OSVERSIONINFO
   
      OSV.OSVSize = Len(OSV)
   
      If GetVersionEx(OSV) = 1 Then         IsWinNTPlus = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And _
                      (OSV.dwVerMajor >= 4)
      End If   #End IfEnd Function
Private Function EnableShutdownPrivledges() As Boolean   Dim hProcessHandle As Long
   Dim hTokenHandle As Long
   Dim lpv_la As LUID
   Dim token As TOKEN_PRIVILEGES
   
   hProcessHandle = GetCurrentProcess()
   
   If hProcessHandle <> 0 Then
   
     'open the access token associated
     'with the current process. hTokenHandle
     'returns a handle identifying the
     'newly-opened access token
      If OpenProcessToken(hProcessHandle, _
                        (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _
                         hTokenHandle) <> 0 Then
   
        'obtain the locally unique identifier
        '(LUID) used on the specified system
        'to locally represent the specified
        'privilege name. Passing vbNullString
        'causes the api to attempt to find
        'the privilege name on the local system.
         If LookupPrivilegeValue(vbNullString, _
                                 "SeShutdownPrivilege", _
                                 lpv_la) <> 0 Then
         
           'TOKEN_PRIVILEGES contains info about
           'a set of privileges for an access token.
           'Prepare the TOKEN_PRIVILEGES structure
           'by enabling one privilege.
            With token
               .PrivilegeCount = 1
               .laa.udtLUID = lpv_la
               .laa.dwAttributes = SE_PRIVILEGE_ENABLED
            End With
   
           'Enable the shutdown privilege in
           'the access token of this process.
           'hTokenHandle: access token containing the
           '  privileges to be modified
           'DisableAllPrivileges: if True the function
           '  disables all privileges and ignores the
           '  NewState parameter. If FALSE, the
           '  function modifies privileges based on
           '  the information pointed to by NewState.
           'token:  TOKEN_PRIVILEGES structure specifying
           '  an array of privileges and their attributes.
           '
           'Since were just adjusting to shut down,
           'BufferLength, PreviousState and ReturnLength
           'can be passed as null.
            If AdjustTokenPrivileges(hTokenHandle, _
                                     False, _
                                     token, _
                                     ByVal 0&, _
                                     ByVal 0&, _
                                     ByVal 0&) <> 0 Then
                                     
              'success, so return True
               EnableShutdownPrivledges = True
   
            End If  'AdjustTokenPrivileges
         End If  'LookupPrivilegeValue
      End If  'OpenProcessToken
   End If  'hProcessHandleEnd Function
'--end block--'

解决方案 »

  1.   

    Option Explicit
    Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
    Public Const EWX_LOGOFF = 0
    Public Const EWX_SHUTDOWN = 1
    Public Const EWX_REBOOT = 2
    Public Const EWX_FORCE = 4
    Public Const TOKEN_ADJUST_PRIVILEGES = &H20
    Public Const TOKEN_QUERY = &H8
    Public Const SE_PRIVILEGE_ENABLED = &H2
    Public Const ANYSIZE_ARRAY = 1Type LUID
        lowpart As Long
        highpart As Long
    End TypeType LUID_AND_ATTRIBUTES
        pLuid As LUID
        Attributes As Long
    End TypeType TOKEN_PRIVILEGES
        PrivilegeCount As Long
        Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
    End TypeDeclare Function GetCurrentProcess Lib "kernel32" () As Long
    Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
    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
    Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongSub AdjustTokenPrivilegesForNT()    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
      
        hdlProcessHandle = GetCurrentProcess()
        OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
                         TOKEN_QUERY), hdlTokenHandle    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
        tkp.PrivilegeCount = 1
        tkp.Privileges(0).pLuid = tmpLuid
        tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED    AdjustTokenPrivileges hdlTokenHandle, False, tkp, _
                              Len(tkpNewButIgnored), tkpNewButIgnored, _
                              lBufferNeeded
       End Sub
    注意:在win2000中关闭计算机的参数应是10才能关机并关闭电源  
      Dim l As Long
      l=ExitWindowsEx(10,0)
     重启动计算机的参数应是2
     Dim l As Long
      l=ExitWindowsEx(2,0)