软件注册站
热情软件屋

 
如何利用VB实现操作系统或者某一应用程序的自动关闭
编号: QA000166    
建立日期: 1998年12月6日 最后修改日期: 2004年1月16日
所属类别: Visual Basic - 其他方面
Visual Basic - Windows API
   
    如何利用vb实现操作系统或者某一应用程序的自动关闭?(周军)
   
    退出操作系统可以调用Windows API的ExitWindowsEx函数。在Win9x下,只要简单地调用ExitWindowsEx函数就可以实现关机或者重新启动。但是在Win 2000/XP下调用ExitWindowsEx函数时,还需要先调用AdjustTokenPrivileges函数。下面的例子在Win9x和Win 2000/XP下都可以使用。请参考程序中的注释。
    例子:
    1、建立一个窗体,在上面放置4个按钮,按钮设置如下:
     控件 控件名 Caption属性
     ---------------------------------------------------
     CommandButton cmdLogoff 注销
     CommandButton cmdForceLogoff 强制注销
     CommandButton cmdShutdown 关机
     CommandButton cmdForceShutdown 强制关机
    2、将下面的代码加入窗体中:
     Option Explicit
     Private Const EWX_LogOff As Long = 0
     Private Const EWX_SHUTDOWN As Long = 1
     Private Const EWX_REBOOT As Long = 2
     Private Const EWX_FORCE As Long = 4
     Private Const EWX_POWEROFF As Long = 8
    
     'ExitWindowsEx函数可以退出登录、关机或者重新启动系统
     Private Declare Function ExitWindowsEx Lib "user32" _
     (ByVal dwOptions As Long, _
     ByVal dwReserved As Long) As Long
    
     'GetLastError函数返回本线程的最后一次错误代码。错误代码是按照线程
     '储存的,多线程也不会覆盖其他线程的错误代码。
     Private Declare Function GetLastError Lib "kernel32" () As Long
    
     Private Const mlngWindows95 = 0
     Private Const mlngWindowsNT = 1
    
     Public glngWhichWindows32 As Long
    
     ' GetVersion返回操作系统的版本。
     Private Declare Function GetVersion Lib "kernel32" () As Long
    
     Private Type LUID
     UsedPart As Long
     IgnoredForNowHigh32BitPart As Long
     End Type
    
     Private Type LUID_AND_ATTRIBUTES
     TheLuid As LUID
     Attributes As Long
     End Type
    
     Private Type TOKEN_PRIVILEGES
     PrivilegeCount As Long
     TheLuid As LUID
     Attributes As Long
     End Type
    
     'GetCurrentProcess函数返回当前进程的一个句柄。
     Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
    
     'OpenProcessToken函数打开一个进程的访问代号。
     Private Declare Function OpenProcessToken Lib "advapi32" _
     (ByVal ProcessHandle As Long, _
     ByVal DesiredAccess As Long, _
     TokenHandle As Long) As Long
    
     'LookupPrivilegeValue函数获得本地唯一的标示符(LUID),用于在特定的系统中
     '表示特定的优先权。
     Private Declare Function LookupPrivilegeValue Lib "advapi32" _
     Alias "LookupPrivilegeValueA" _
     (ByVal lpSystemName As String, _
     ByVal lpName As String, _
     lpLuid As LUID) As Long
    
     'AdjustTokenPrivileges函数使能或者禁用指定访问记号的优先权。
     '使能或者禁用优先权需要TOKEN_ADJUST_PRIVILEGES访问权限。
     Private Declare Function AdjustTokenPrivileges Lib "advapi32" _
     (ByVal TokenHandle As Long, _
     ByVal DisableAllPrivileges As Long, _
     NewState As TOKEN_PRIVILEGES, _
     ByVal BufferLength As Long, _
     PreviousState As TOKEN_PRIVILEGES, _
     ReturnLength As Long) As Long
    
     Private Declare Sub SetLastError Lib "kernel32" _
     (ByVal dwErrCode As Long)
    
     Private Sub AdjustToken()
    
     '********************************************************************
     '* 这个过程设置正确的优先权,以允许在Windows NT下关机或者重新启动。
     '********************************************************************
    
     Const TOKEN_ADJUST_PRIVILEGES = &H20
     Const TOKEN_QUERY = &H8
     Const SE_PRIVILEGE_ENABLED = &H2
    
     Dim hdlProcessHandle As Long
     Dim hdlTokenHandle As Long
     Dim tmpLuid As LUID
     Dim tkp As TOKEN_PRIVILEGES
     Dim tkpNewButIgnored As TOKEN_PRIVILEGES
     Dim lBufferNeeded As Long
    
     '使用SetLastError函数设置错误代码为0。
     '这样做,GetLastError函数如果没有错误会返回0
     SetLastError 0
    
     ' GetCurrentProcess函数设置 hdlProcessHandle变量
     hdlProcessHandle = GetCurrentProcess()
    
     If GetLastError <> 0 Then
     MsgBox "GetCurrentProcess error==" & GetLastError
     End If
    
     OpenProcessToken hdlProcessHandle, _
     (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
    
     If GetLastError <> 0 Then
     MsgBox "OpenProcessToken error==" & GetLastError
     End If
    
     ' 获得关机优先权的LUID
     LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
    
     If GetLastError <> 0 Then
     MsgBox "LookupPrivilegeValue error==" & GetLastError
     End If
    
     tkp.PrivilegeCount = 1 ' 设置一个优先权
     tkp.TheLuid = tmpLuid
     tkp.Attributes = SE_PRIVILEGE_ENABLED
    
     ' 对当前进程使能关机优先权
     AdjustTokenPrivileges hdlTokenHandle, _
     False, _
     tkp, _
     Len(tkpNewButIgnored), _
     tkpNewButIgnored, _
     lBufferNeeded
    
     If GetLastError <> 0 Then
     MsgBox "AdjustTokenPrivileges error==" & GetLastError
     End If
    
     End Sub
    
     Private Sub cmdLogoff_Click()
    
     ExitWindowsEx (EWX_LogOff), &HFFFF
     MsgBox "ExitWindowsEx's GetLastError " & GetLastError
    
     End Sub
    
     Private Sub cmdForceLogoff_Click()
    
     ExitWindowsEx (EWX_LogOff Or EWX_FORCE), &HFFFF
     MsgBox "调用ExitWindowsEx函数后的GetLastError " & GetLastError
    
     End Sub
    
     Private Sub cmdShutdown_Click()
    
     If glngWhichWindows32 = mlngWindowsNT Then
     AdjustToken
     MsgBox "调用AdjustToken后的GetLastError " & GetLastError
     End If
    
     ExitWindowsEx (EWX_SHUTDOWN), &HFFFF
     MsgBox "调用ExitWindowsEx函数后的GetLastError " & GetLastError
    
     End Sub
    
     Private Sub cmdForceShutdown_Click()
     If glngWhichWindows32 = mlngWindowsNT Then
     AdjustToken
     MsgBox "调用AdjustToken后的GetLastError " & GetLastError
     End If
    
     ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), &HFFFF
     MsgBox "ExitWindowsEx's GetLastError " & GetLastError
    
     End Sub
    
     Private Sub Form_Load()
     '********************************************************************
     '* 当项目启动时,调用GetVersion检查操作系统。
     '********************************************************************
     Dim lngVersion As Long
    
     lngVersion = GetVersion()
    
     If ((lngVersion And &H80000000) = 0) Then
     glngWhichWindows32 = mlngWindowsNT
     MsgBox "在Windows NT或Windows 2000下运行"
     Else
     glngWhichWindows32 = mlngWindows95
     MsgBox "在Windows 95/98/Me下运行"
     End If
    
     End Sub
    

    3、编译成EXE,然后退出VB运行该EXE程序。
    另外,可以参考徐景周的Shutdown.zip例子。
    关闭应用程序可以利用SendKeys语句向该程序发送Alt+F4键或利用Windows API的SendMessage函数发送WM_QUIT消息。

    

此问题由李海回答。

附加关键字:编程, 源程序, programming, source code, Visual Basic, VB, 其他方面, , Windows API, win32, api, windows api, gdi32, kernel

   
 
把这个问题推荐给朋友
   
 
   
您的意见类别
您的名字
您的电子邮件
您的建议(请尽可能详细)
 
 

版权所有 1997-2008 热情软件屋
如果您有任何建议和意见, 请给我发个电子邮件 askpro@china-askpro.com
Web Designed by ZebraStudio