How can I lock an application after period of user inactivity?

How can I lock an application after period of user inactivity?

I have a fat Windows applocation written in VB6. User must log into the application to use it. I need to log the user out after a period of inactivity. There are over 100 separate forms with one Main form that is alway开发者_运维技巧s open after the user logs in, so I am looking for an application solution not a form level solution.

I am thinking about monitoring keyboard and mouse usage using WIN API.

---

Are you looking to measure inactivity in/of the application? Or the entire desktop?

If the latter, I’d suggest looking at GetLastInputInfo which you could call from time to time, either from another app, or from a timer in your main window. You can find a VB6 example of it's use here, though you can call it from just about any language you want as it is a Win32 API.

---

Here is the solution I decided upon. I wanted to document it properly. As this is the approach I had envisioned, it is not my code. Someone smarter than I did awhile ago.
I simply implemented the solution into my application.

Solution was posted by DaVBMan Sample code
Original discussion thread.

The app is an multiple-document interface app.

In a common.bas module:

WIN API Code: for Keyboard and Mouse monitoring:

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

Global variables to hold DateTime last user activity and if mouse and keyboard activity has occurred

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

Code to detect keyboard activity

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

Code to detect mouse movement:

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

On the Main parent Form: Added a timer:

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

Also on the MainForm load event:

Private Sub MDIForm_Load()
   HookKeyboard
end sub

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