需要提升进程权限的模块
Attribute VB_Name = "Exit_Windows"
Option Explicit
Option Base 0
Private Declare Function ExitWindowsEx()Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetVersionEx()Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetCurrentProcess()Function GetCurrentProcess Lib "kernel32" () As Long
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
''Detect if the program is running under Windows NT
Private Function IsWinNT()Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
'' Shut Down NT
Public Sub ShutDownNT()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 Call EnablePrivileges(GetCurrentProcess(), SE_SHUTDOWN_NAME)
ExitWindowsEx Flags, 0
End Sub
''Restart NT
Public Sub RebootNT()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 Call EnablePrivileges(GetCurrentProcess(), SE_SHUTDOWN_NAME)
ExitWindowsEx Flags, 0
End Sub
''Log off the current user
Public Sub LogOffNT()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
Public Const SE_UNSOLICITED_INPUT_NAME = "SeUnsolicitedInputPrivilege"
Private Const SE_DACL_DEFAULTED = &H8
Private Const SE_DACL_PRESENT = &H4
Private Const SE_ERR_ACCESSDENIED = 5
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_FNF = 2
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_OOM = 8
Private Const SE_ERR_PNF = 3
Private Const SE_ERR_SHARE = 26
Private Const SE_GROUP_DEFAULTED = &H2
Private Const SE_GROUP_ENABLED = &H4
Private Const SE_GROUP_ENABLED_BY_DEFAULT = &H2
Private Const SE_GROUP_LOGON_ID = &HC0000000
Private Const SE_GROUP_MANDATORY = &H1
Private Const SE_GROUP_OWNER = &H8
Private Const SE_OWNER_DEFAULTED = &H1
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const SE_PRIVILEGE_ENABLED_BY_DEFAULT = &H1
Private Const SE_PRIVILEGE_USED_FOR_ACCESS = &H80000000
Private Const SE_SELF_RELATIVE = &H8000
Private Const SE_SACL_DEFAULTED = &H20
Private Const SE_SACL_PRESENT = &H10
''********************************************
Public Sub EnablePrivileges()Sub EnablePrivileges(hProc As Long, PrivilegeName As String)
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken
LookupPrivilegeValue "", PrivilegeName, mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
CloseHandle hToken
End Sub
责任编辑：小草
