Excel VBA中用API实现关机

吕?布

界面

窗体代码
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 CommandButton1_Click()

    Dim uflags As Long
    Dim success As Long

    If OptionButton1.Value = True Then uflags = EWX_LOGOFF
    If OptionButton2.Value = True Then uflags = EWX_SHUTDOWN
    If OptionButton3.Value = True Then uflags = EWX_REBOOT
    If OptionButton4.Value = True Then uflags = EWX_POWEROFF

    If CheckBox1.Value = True Then uflags = uflags Or EWX_FORCE
    If CheckBox2.Value = True Then uflags = uflags Or EWX_FORCEIFHUNG

    ' 如果运行Windows NT或以上版本,
    ' 要调整关机权限, 允许调用ExitWindowsEx, 如果调整失败, 则返回False, 不能关机
    If IsWinNTPlus() Then

        success = EnableShutdownPrivledges()
        If success Then Call ExitWindowsEx(uflags, 0&)

    Else

        ' 9x 系统
        Call ExitWindowsEx(uflags, 0&)

    End If

End Sub


Private Function IsWinNTPlus() As Boolean

'如果系统是 Windows NT, Windows 2000, Windows XP, 或者.net server, 返回True
    #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
                    .PrivilegeCount = 1
                    .laa.udtLUID = lpv_la
                    .laa.dwAttributes = SE_PRIVILEGE_ENABLED
                End With

                If AdjustTokenPrivileges(hTokenHandle, _
                                         False, _
                                         token, _
                                         ByVal 0&, _
                                         ByVal 0&, _
                                         ByVal 0&) <> 0 Then

                    EnableShutdownPrivledges = True

                End If
            End If
        End If
    End If

End Function

Private Sub CommandButton2_Click()
    Unload Me
End Sub
附件 API关机函数.rar (11.43 KB, 下载次数: 79)

2011-2-15 13:42 上传

点击文件名下载附件

爱疯

谢谢吕布！
到时，认真学习[em26]

阿童木

不错。学习

那么的帅

谢谢吕布！

清风明月12

太谢谢楼主了，我正需要这个呢。