[此贴子已经被作者于2006-4-8 17:28:36编辑过]
Option Explicit
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private 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 only
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Type OSVERSIONINFO
OSVSize As Long
dwVerMajor As Long
dwVerMinor As Long
dwBuildNumber As Long
PlatformID As Long
szCSDVersion As String * 128
End Type
Private Type LUID
dwLowPart As Long
dwHighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
udtLUID As LUID
dwAttributes As Long
End Type
Private 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 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 Long) As Long
Private 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
success = True
If IsWinNTPlus Then
success = EnableShutdownPrivledges()
End If
If success Then Call ExitWindowsEx(uflags, 0&)
End Sub
Private Function IsWinNTPlus() As Boolean
#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 If
End 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
If OpenProcessToken(hProcessHandle, _
(TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _
hTokenHandle) <> 0 Then
If LookupPrivilegeValue(vbNullString, _
"SeShutdownPrivilege", _
lpv_la) <> 0 Then
With token
End With
If AdjustTokenPrivileges(hTokenHandle, _
False, _
token, _
ByVal 0&, _
ByVal 0&, _
ByVal 0&) <> 0 Then
EnableShutdownPrivledges = True
End If 'AdjustTokenPrivileges
End If 'LookupPrivilegeValue
End If 'OpenProcessToken
End If 'hProcessHandle
End Function