利用微软未公开的WindowsAPI函数关闭或注销或重新启动计算机

         众所周知，微软公开的用来关闭、注销、重新启动计算机的API是ExitWindowsEx。在Windows95/98下，可直接用ExitWindowsEx，即可正确关闭、注销、重新启动计算机；因Windows2000及Windows2000以上的操作系统全都是WindowsNT系统，调用进程必须使用API函数AdjustTokenPrivileges函数获取SE_SHUTDOWN_NAME特权，才能用ExitWindowsEx正确关闭、注销、重新启动计算机。
        本文所述的微软“未公开”的API函数，是微软为了某种目的，对于一些封装在系统中的函数没有在任何开发文档中提供任何函数说明和定义。而这些函数有很多都是非常有用的！下面程序中用到的2个API函数是微软没有公开的函数。因为不知道函数名是什么，所以在Alias之后没有使用函数的真正名字，而是使用了函数编号#59、#60，这是因为微软没有公开函数名称。函数编号#59、#60是位于动态链接库shell32.dll中的2个非常有用的API。#59用于弹出关闭计算机对话框，相当于鼠标按“开始”，再按“关闭计算机”，将调用系统关闭计算机对话框；#60用来提示用户重新启动计算机或不重新启动计算机，弹出系统对话框，特别是用户安装了软件之后用来提示用户是否重新启动计算机。
        程序运行后，单击“弹出关闭计算机对话框”按钮就可以弹出关闭系统对话框。在组合框Combo1中选择“注销计算机”、“关闭计算机电源”、“重新启动计算机”、“强行关闭计算机”，再单击“关闭重启注销计算机”按钮，系统就会弹出提示对话框提示是否执行相应的操作，点击“是”就可以执行了。
        下面程序在Windows98/2000/XP，Windows7下测试成功，居然通用。

        窗体Form1模块：

Option Explicit
'窗体Form1上放一个组合框Combo1，二个命令按钮Command1、Command2
Private Sub Command1_Click()
    Call SHShutDownDialog(0) '相当于鼠标按“开始”，再按“关闭计算机”，将调用系统关闭计算机对话框
End Sub
 
Private Sub Command2_Click()
    Dim sPrompt As String, Ret As Long
    Dim uFlag As Long
    If Combo1.ListIndex = -1 Then Exit Sub
    Select Case Combo1.ListIndex
        Case 0
             uFlag = Val(Combo1.Text)            '0注销计算机
             sPrompt = "注销计算机!" & vbCrLf & vbCrLf
             sPrompt = GetStrFromPtr(StrPtr(sPrompt), LenB(sPrompt))
             Ret = SHRestartSystemMB(Me.hWnd, CheckString(sPrompt), uFlag)
        Case 1
             uFlag = shrsExitNoDefPrompt         '1关闭计算机电源
             sPrompt = "关闭计算机电源!" & vbCrLf & vbCrLf
             sPrompt = GetStrFromPtr(StrPtr(sPrompt), LenB(sPrompt))
             Ret = SHRestartSystemMB(Me.hWnd, CheckString(sPrompt), uFlag)
        Case 2
             uFlag = shrsRebootSystem            '2重新启动计算机
             sPrompt = "重新启动计算机!" & vbCrLf & vbCrLf
             sPrompt = GetStrFromPtr(StrPtr(sPrompt), LenB(sPrompt))
             Ret = SHRestartSystemMB(Me.hWnd, CheckString(sPrompt), uFlag)
        Case 3
             uFlag = (EWX_POWEROFF Or EWX_FORCE) '4强行关闭计算机
             sPrompt = "强行关闭计算机!" & vbCrLf & vbCrLf
             sPrompt = GetStrFromPtr(StrPtr(sPrompt), LenB(sPrompt))
             Ret = SHRestartSystemMB(Me.hWnd, CheckString(sPrompt), uFlag)
    End Select
End Sub
 
Private Sub Form_Load()
    bIsWinNT = IsWinNT()
    If bIsWinNT Then 'WinNT操作系统
       With Combo1
            .AddItem "0 - 注销计算机"
            .AddItem "1 - 关闭计算机电源"
            .AddItem "2 - 重新启动计算机"
            .AddItem "3 - 强行关闭计算机"
            .Text = "请选择"
       End With
    Else            'Win95/98操作系统
       With Combo1
            .AddItem "0 - 注销计算机"
            .AddItem "1 - 关闭计算机电源"
            .AddItem "2 - 重新启动计算机"
            .AddItem "3 - 强行关闭计算机"
            .Text = "请选择"
       End With
   End If
   Command1.Caption = "弹出关闭计算机对话框"
   Command2.Caption = "关闭重启注销计算机"
End Sub

 

        标准模块：Module1.bas

Option Explicit
  
'NT系统标志
Public bIsWinNT As Boolean
 
'下面是微软没有公开的函数定义。因为不知道函数名是什么，所以在Alias之后没有使用函数的真正名字，而是使用了函数编号，这是因为微软没有公开函数名。

'API#59，用于关闭、注销、重新启动计算机
Public Declare Function SHRestartSystemMB Lib "shell32" Alias "#59" (ByVal hOwner As Long, ByVal sExtraPrompt As String, ByVal uFlags As Long) As Long
'API#60，用于弹出关闭计算机对话框
Public Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function IsTextUnicode Lib "advapi32" (lpBuffer As Any, ByVal cb As Long, lpi As Long) As Long

Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
End Type

Public Const EWX_LOGOFF As Long = 0& '关闭所有进程，然后注销用户。
Public Const EWX_SHUTDOWN As Long = 1& '关闭系统，安全地关闭电源。所有文件缓冲区已经刷新到磁盘上，所有正在运行的进程已经停止。
Public Const EWX_REBOOT As Long = 2& '关闭系统，然后重新启动系统。
Public Const EWX_FORCE As Long = 4& '强制终止进程。当此标志设置，Windows不会发送消息WM_QUERYENDSESSION和WM_ENDSESSION的消息给目前在系统中运行的程序。这可能会导致应用程序丢失数据。因此，你应该只在紧急情况下使用此标志。
Public Const EWX_POWEROFF As Long = 8& '关闭系统并关闭电源。该系统必须支持断电。
Public Const shrsExitNoDefPrompt As Long = 1&
Public Const shrsRebootSystem As Long = 2&

Private Const VER_PLATFORM_WIN32s As Long = 0&
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1&
Private Const VER_PLATFORM_WIN32_NT As Long = 2&

Private Const IS_TEXT_UNICODE_ASCII16 As Long = &H1&
Private Const IS_TEXT_UNICODE_REVERSE_ASCII16 As Long = &H10&
Private Const IS_TEXT_UNICODE_STATISTICS As Long = &H2&
Private Const IS_TEXT_UNICODE_REVERSE_STATISTICS As Long = &H20&
Private Const IS_TEXT_UNICODE_CONTROLS As Long = &H4&
Private Const IS_TEXT_UNICODE_REVERSE_CONTROLS As Long = &H40&
Private Const IS_TEXT_UNICODE_SIGNATURE As Long = &H8&
Private Const IS_TEXT_UNICODE_REVERSE_SIGNATURE As Long = &H80&
Private Const IS_TEXT_UNICODE_ILLEGAL_CHARS As Long = &H100&
Private Const IS_TEXT_UNICODE_ODD_LENGTH As Long = &H200&
Private Const IS_TEXT_UNICODE_DBCS_LEADBYTE As Long = &H400&
Private Const IS_TEXT_UNICODE_NULL_BYTES As Long = &H1000&
Private Const IS_TEXT_UNICODE_UNICODE_MASK As Long = &HF&
Private Const IS_TEXT_UNICODE_REVERSE_MASK As Long = &HF0&
Private Const IS_TEXT_UNICODE_NOT_UNICODE_MASK As Long = &HF00&
Private Const IS_TEXT_UNICODE_NOT_ASCII_MASK As Long = &HF000&
 
'判断是否NT系统
Public Function IsWinNT() As Boolean
    Dim osvi As OSVERSIONINFO
    osvi.dwOSVersionInfoSize = Len(osvi)
    GetVersionEx osvi
    IsWinNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
 
'检查字符串
Public Function CheckString(msg As String) As String
    If bIsWinNT Then
       CheckString = StrConv(msg, vbUnicode)
    Else
       CheckString = msg
    End If
End Function
 
'从起始地址获得字符串
Public Function GetStrFromPtr(lpszStr As Long, nBytes As Integer) As String
    ReDim ab(nBytes) As Byte
    CopyMemory ab(0), ByVal lpszStr, nBytes
    GetStrFromPtr = GetStrFromBuffer(StrConv(ab(), vbUnicode))
End Function

'从缓冲区获得字符串
Public Function GetStrFromBuffer(szStr As String) As String
    If IsUnicodeStr(szStr) Then
       szStr = StrConv(szStr, vbFromUnicode)
    End If
    If InStr(szStr, vbNullChar) Then
       GetStrFromBuffer = Left$(szStr, InStr(szStr, vbNullChar) - 1)
    Else
       GetStrFromBuffer = szStr
    End If
End Function
 
'是否Unicode字符串
Public Function IsUnicodeStr(sBuffer As String) As Boolean
    Dim dwRtnFlags As Long
    dwRtnFlags = IS_TEXT_UNICODE_UNICODE_MASK
    IsUnicodeStr = IsTextUnicode(ByVal sBuffer, Len(sBuffer), dwRtnFlags)
End Function