Как я могу заблокировать приложение после периода неактивности пользователя?

Question

Как я могу заблокировать приложение после периода бездеятельности пользователя?

У меня толстое приложение Windows, написанное на VB6.Пользователь должен войти в приложение, чтобы использовать его.Мне нужно выйти из системы после определенного периода бездействия.Существует более 100 отдельных форм с одной главной формой, которая всегда открыта после входа пользователя, поэтому я ищу решение для приложения, а не решение на уровне формы.

Я думаю о мониторинге использования клавиатуры и мыши с помощью WIN API.

Answer 1

Вы хотите измерить бездействие в / из приложения?Или весь рабочий стол?

Если последнее, я бы посоветовал посмотреть GetLastInputInfo , который вы могли бы время от времени вызывать, либо из другого приложения, либо из таймера в главном окне.,Вы можете найти пример использования VB6 здесь , хотя вы можете вызывать его практически с любого языка, который вам нужен, поскольку это Win32 API.

Answer 2

Вот решение, которое я решил.Я хотел документировать это правильно.Так как это подход, который я предполагал, это не мой код.Кто-то умнее, чем я некоторое время назад.
Я просто внедрил решение в свое приложение.

Решение опубликовано DaVBMan Пример кода
Оригинальная ветка обсуждения .

Приложение представляет собой приложение с интерфейсом для работы с несколькими документами.

В модуле common.bas:

Код API WIN: для клавиатуры иМониторинг мыши:

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