精华区文章阅读

发信人: student (earth), 信区: VB
标  题: 利用API函数实现 Win95/98/NT 的注销、重启、关闭计�
发信站: 哈工大紫丁香 (2001年08月28日12:10:52 星期二), 站内信件

'利用API函数模拟 Win95/98/NT 的注销、重启、关闭计算机
Option Explicit
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_WIN32_NT = 2        '操作系统类型( 2-NT )
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long   '结构的大小（148）<在正式调用函数之前，必须
先将这个结构的dwOSVersionInfoSize字段设为结构的大小（148）>
    dwMajorVersion As Long        '主版本号
    dwMinorVersion As Long        '次版本号
    dwBuildNumber As Long         '生成号
    dwPlatformId As Long          '操作系统类型( 1-95/98 ;  2-NT )
    szCSDVersion As String * 128  '版本号(形如'第几版')
End Type
Private Type LUID
    LowPart As Long
    HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
'获取当前进程的一个伪句柄
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandl
e As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPr
ivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid
As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHa
ndle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEG
ES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLen
gth As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, B
yVal dwReserved As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (
ByRef lpVersionInformation As OSVERSIONINFO) As Long
'测试系统类型，如果运行在NT下不用此过程
Public Function IsWinNT() As Boolean
    Dim myOS As OSVERSIONINFO
    myOS.dwOSVersionInfoSize = Len(myOS)
    GetVersionEx myOS
    IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
'授权当前应用程序的关闭操作系统权限
Private Sub EnableShutDown()
    Dim hProc As Long
    Dim hToken As Long
    Dim mLUID As LUID
    Dim mPriv As TOKEN_PRIVILEGES
    Dim mNewPriv As TOKEN_PRIVILEGES
    hProc = GetCurrentProcess()   '获取当前进程的一个伪句柄
    OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
    LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
    mPriv.PrivilegeCount = 1
    mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    mPriv.Privileges(0).pLuid = mLUID
    '允许当前应用程序有关闭操作系统的权限
    AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCou
nt), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
' 关闭计算机
Public 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 EnableShutDown
    ExitWindowsEx Flags, 0
End Sub
'重启计算机
Public 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 EnableShutDown
    ExitWindowsEx Flags, 0
End Sub
'注销当前用户
Public 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
Private Sub Command1_Click()
    LogOffNT True
End Sub
Private Sub Command2_Click()
    RebootNT True
End Sub
Private Sub Command3_Click()
    ShutDownNT True
End Sub
Private Sub Form_Load()
    'Command1.Caption = "Log Off NT"
    'Command2.Caption = "Reboot NT"
    'Command3.Caption = "Shutdown NT"
End Sub

--
※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.170.186]

VB 版 (精华区)