一段时间后，VB应用程序没有任何操作（键盘和鼠标没有任何操作），怎么自动关闭（能不能不在应用程序中写代码）？
RT 问题点数：20、回复次数：6Top
1 楼ZOU_SEAFARER（颓废程序员^_^）回复于 2006-03-17 10:16:27 得分 4
Private Sub Form_Load()
Me.Timer1.Interval = 1000
End Sub
Private Sub Timer1_Timer()
If Time = "9:00:00" Then End
Debug.Print Time
End Sub
定时退出程序Top
2 楼xDAVIDx（DAVID）回复于 2006-03-17 11:00:56 得分 3
我觉得思路可以是这样:
每次进行操作时,记录下当前系统时间,然后设置一个Timer控件,将当前时间与上次操作时间做比较,若相差大于某个时间则关闭程序.Top
3 楼ExeMan（愚公移山(笨)--精卫填海(傻)）回复于 2006-03-17 11:06:10 得分 3
捕捉键盘与鼠标操作。有操作时，记录当前操作时间。
无操作时，用Timer判断系统时间与操作时间比较。达到一定时长后，关闭退出。Top
4 楼zpsinz（青空有雾）回复于 2006-03-17 11:07:34 得分 2
timer 控件，设置查询间隔，如预定的时间段
进入程序后，记录当前时间
每次操作，重新开始timer
如果没操作，相当于timer进入到第2次，则关闭程序
这样应该可以节约不少系统开销。Top
5 楼songlaf（疯子）回复于 2006-03-17 11:07:48 得分 0
但是问题，有些操作，比如他用鼠标在某一个窗口上点了，一下，没有做任何操作。
这时候也不应该关闭程序的阿Top
6 楼laviewpbt（人一定要靠自己）回复于 2006-03-17 11:40:45 得分 8
Option Explicit
Private Const WM_SYSCOMMAND = &H112&
Private Const SC_MONITORPOWER = &HF170&
Private Const SC_SCREENSAVE = &HF140&
Private Const SE_SHUTDOWN_PRIVILEGE& = 19
Private Const SHUTDOWN& = 0
Private Const POWEROFF& = 2
Private Const EWX_SHUTDOWN = 1
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 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 Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare Function GetLastInputInfo Lib "user32" (plii As LASTINPUTINFO) As Boolean
Private Declare Function RtlAdjustPrivilege& Lib "ntdll" (ByVal Privilege&, ByVal NewValue&, ByVal NewThread&, Oldvalue&)
Private Declare Function NtShutdownSystem& Lib "ntdll" (ByVal ShutdownAction&)
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 TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function LockWorkStation Lib "user32" () As Boolean
'*************************************************************************
'** 作 者 ： laviewpbt
'** 函 数 名 ： ShutDownNT
'** 输 入 ： Force(Boolean)
'** 输 出 ： 无
'** 功能描述 ： 快速强制关闭系统
'** 日 期 ： 2005-11-5 20.51.32
'** 修 改 人 ：
'** 日 期 ：
'** 版 本 ： Version 1.2.1
'*************************************************************************
Private Sub ShutDownNT(Force As Boolean)
Dim Ret As Long
Dim flags As Long
flags = EWX_SHUTDOWN
If Force Then flags = flags + EWX_FORCE
EnableShutDown
ExitWindowsEx flags, 0
End Sub
'*************************************************************************
'** 作 者 ： somebody
'** 函 数 名 ： EnableShutDown
'** 输 入 ： 无
'** 输 出 ： 无
'** 功能描述 ： 获得权限
'** 日 期 ： 2005-11-5 20.53.42
'** 修 改 人 ： laviewpbt
'** 日 期 ：
'** 版 本 ： Version 1.2.1
'*************************************************************************
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.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
'*************************************************************************
'** 作 者 ： laviewpbt
'** 函 数 名 ： IdleAction
'** 输 入 ： Action(String) 动作类型
'** 输 出 ： 无
'** 功能描述 ： 根据设置，判断当一定时间没有鼠标键盘时如何动作
'** 日 期 ： 2005-11-5 20.53.42
'** 修 改 人 ： laviewpbt
'** 日 期 ： 2006-3-17 11:33
'** 版 本 ： Version 1.3.1
'*************************************************************************
Private Sub IdleAction(Action As String)
Select Case Action
Case "CloseMe"
Unload Me
Case "CloseLCD"
SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal 2& ' 关闭显示器
Case "ScreenSaver"
SendMessage Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0 ' 屏幕保护
Case "LockComputer"
LockWorkStation ' 锁定计算机
Case "ShutDownSystemDirectly"
RtlAdjustPrivilege SE_SHUTDOWN_PRIVILEGE, 1, 0, 0 ' 强制关闭
NtShutdownSystem SHUTDOWN
Case "ShutDownSystemNormaly"
ShutDownNT True ' 正常关闭
End Select
End Sub
Private Sub Timer1_Timer()
Dim lii As LASTINPUTINFO
Dim Action As String, IdleSpan As Single
lii.cbSize = Len(lii)
GetLastInputInfo lii
IdleSpan = GetSetting(App.Title, App.Title, "IdleSpan", 0.01) '得到设置的时间间隔，以分钟为单位，这里0.01为起示范作用的
If (GetTickCount - lii.dwTime) * 0.001 > IdleSpan * 60 Then '这部分可以适当改动，以使用不同需求
Action = GetSetting(App.Title, App.Title, "Action", "LockComputer")
Call IdleAction(Action)
End If
End Sub
在XP系统下测试通过。Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
