[此贴子已经被作者于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