Question

如何在用户不活动一段时间后锁定应用程序？

我有一个用VB6编写的胖Windows应用程序。用户必须登录应用程序才能使用它。我需要在一段时间不活动后将用户注销。有超过100个单独的表单，其中一个Main表单在用户登录后始终打开，因此我正在寻找一个应用程序解决方案而不是表单级别的解决方案。

我正在考虑使用WIN API监控键盘和鼠标的使用情况。

Answer 1

您是否希望测量应用程序中的不活动状态？还是整个桌面？

如果是后者，我建议您不时地从另一个应用程序或主窗口中的计时器查看GetLastInputInfo。您可以找到一个使用here的VB6示例，尽管您可以使用几乎任何语言来调用它，因为它是Win32 API。

Answer 2

这是我决定的解决方案。我想要正确记录它。由于这是我设想的方法，它不是我的代码。比我前一段时间更聪明的人我只是将解决方案应用到我的应用程序中。

解决方案由DaVBMan发布 Sample code
Original discussion thread

该应用是一个多文档界面应用。

在common.bas模块中：

WIN API代码：用于键盘和鼠标监控：

Private Const WH_KEYBOARD_LL = 13&
Private Const HC_ACTION = 0&
Private Const LLKHF_EXTENDED = &H1&
Private Const LLKHF_INJECTED = &H10&
Private Const LLKHF_ALTDOWN = &H20&
Private Const LLKHF_UP = &H80&

Private Const VK_RIGHT = &H27
Private Const VK_LEFT = &H25
Private Const VK_RSHIFT = &HA1

Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  Flags As Long
  time As Long
  dwExtraInfo As Long
End Type

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private m_hDllKbdHook As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

用于保存DateTime上次用户活动以及是否发生鼠标和键盘活动的全局变量

Public KeysHaveBeenPressed As Boolean
Public HasMouseMoved As Boolean
Public gLastUserActivity As Date

检测键盘活动的代码

Public Function HookKeyboard() As Long
    On Error GoTo ErrorHookKeyboard
    m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
    HookKeyboard = m_hDllKbdHook
    Exit Function
ErrorHookKeyboard:
    MsgBox Err & ":Error in call to HookKeyboard()." _
    & vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
    Exit Function
End Function
Public Sub UnHookKeyboard()
    On Error GoTo ErrorUnHookKeyboard
    UnhookWindowsHookEx (m_hDllKbdHook)
    Exit Sub
ErrorUnHookKeyboard:
    MsgBox Err & ":Error in call to UnHookKeyboard()." _
    & vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
    Exit Sub
End Sub
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Static kbdllhs As KBDLLHOOKSTRUCT
    If nCode = HC_ACTION Then
        'keys have been pressed
        KeysHaveBeenPressed = True
    End If
    LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, nCode, wParam, lParam)
End Function

检测鼠标移动的代码：

Public Sub CheckMouse()
    On Error GoTo ErrCheckMouse
    Dim p As POINTAPI
    GetCursorPos p
    If p.x <> LastMouse.x Or p.y <> LastMouse.y Then
        HasMouseMoved = True
        LastMouse.x = p.x
        LastMouse.y = p.y
    End If
    Exit Sub
ErrCheckMouse:
    MsgBox Err.Number & ": Error in CheckMouse().  Error Description: " & Err.Description, vbCritical, "Error"
    Exit Sub
End Sub

在主要父表格上：添加了一个计时器：

Private Sub muTimer_Timer()
    CheckMouse
    'Debug.Print "MU Timer Fire"
    'Debug.Print "Keyboard:" & KeysHaveBeenPressed & " - " & "Mouse:" & HasMouseMoved
    If HasMouseMoved = False And KeysHaveBeenPressed = False Then
        If DateDiff("m", gLastUserActivity, Now) > gnMUTimeOut Then
            muTimer.Interval = 0
            <Make call to lock the application>           
        Else
            'Debug.Print "  dT "; DateDiff("s", gLastUserActivity, Now) 
        End If
    Else
        HasMouseMoved = False
        KeysHaveBeenPressed = False
        gLastUserActivity = Now
    End If
    'Debug.Print "  dT "; DateDiff("s", gLastUserActivity, Now)    
End Sub

同样在MainForm加载事件：

Private Sub MDIForm_Load()
   HookKeyboard
end sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  UnHookKeyboard
end sub

如何在用户不活动一段时间后锁定应用程序？

2 个答案: