Application Idle Time

I would not use a low-level keyboard/mouse hook in your application unless you absolutely have to...

This is a modified version of Arks code in the article you referenced.  If you only have one form in your app it will work fine:

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function GetQueueStatus Lib "user32" _
   (ByVal fuFlags As Long) As Long

Private Const QS_KEY = &H1
Private Const QS_MOUSEMOVE = &H2
Private Const QS_MOUSEBUTTON = &H4
Private Const QS_MOUSE = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT = (QS_MOUSE Or QS_KEY)

Public bCancel As Boolean

Private Sub Command1_Click()
    CheckInputIdle 1 ' one minute idle time out
End Sub

Private Sub Form_Unload(Cancel As Integer)
    bCancel = True ' kill the polling loop if it is running
End Sub

Public Sub CheckInputIdle(ByVal TimeOut_InMinutes As Long)
    Dim idleTarget As Date
 
    idleTarget = DateAdd("n", TimeOut_InMinutes, Now())
    Debug.Print "idleTarget = " & idleTarget
    Do While bCancel = False
        If GetQueueStatus(QS_INPUT) Then
            idleTarget = DateAdd("n", TimeOut_InMinutes, Now())
            Debug.Print "New idleTarget = " & idleTarget
        End If
       
        DoEvents ' keep app responsive
        Sleep 50 ' keep CPU usage down
   
        If Now() >= idleTarget Then
            Exit Do
        End If
    Loop
   
    ' optional MsgBox...
    If bCancel = False Then
        MsgBox "Process idle is for " & TimeOut_InMinutes & " minutes."
    End If
   
    Unload Me ' end the application
End Sub

Dear Idle Mind,

Thank you for your quick response.  I believe I need to use a low-level keyboard/mouse hook strategy because my application is an mdi app with about 20 forms in it.  The user could be sitting idle on any one of the forms.  I certainly wouldn't want to duplicate idle processing code in each form.

I am certainly willing to entertain other approaches to solving this problem, however the approach that is discussed in this article is simple enough and is almost working flawlessly except for the problem mentioned above.

To make it easy for you I have included a code sample for you to debug.  Paste this code into a bas module:

Private Declare Function SetWindowsHookEx Lib "user32.dll" 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.dll" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WH_KEYBOARD As Long = 2
Private Const WH_MOUSE As Long = 7

Private mhMouseHook As Long
Private mhKeyboardHook As Long
Private mlIdleTime As Long

'--------------------------------------------------------------------------
' Procedure:    IdleHook
' Purpose:      Call this routine when the application starts.
'--------------------------------------------------------------------------
Public Sub IdleHook()
    mhMouseHook = SetWindowsHookEx(WH_MOUSE, AddressOf Mouse_IO, 0&, App.ThreadID)
    mhKeyboardHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf Keyboard_IO, 0&, App.ThreadID)
End Sub

'--------------------------------------------------------------------------
' Procedure:    IdleUnhook
' Purpose:      Call this routine when the application ends.
'--------------------------------------------------------------------------
Public Sub IdleUnhook()
    Call UnhookWindowsHookEx(mhMouseHook)
    Call UnhookWindowsHookEx(mhKeyboardHook)
End Sub

'--------------------------------------------------------------------------
' Procedure:    Mouse_IO
' Called When:  This routine will be called when we detect mouse activity.
' Purpose:      Reset the idle time.
'--------------------------------------------------------------------------
Private Function Mouse_IO(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Mouse_IO = CallNextHookEx(mhMouseHook, nCode, wParam, lParam)
    mlIdleTime = 0
End Function

'--------------------------------------------------------------------------
' Procedure:    Keyboard_IO
' Called When:  This routine will be called when we detect keyboard activity.
' Purpose:      Reset the idle time.
'--------------------------------------------------------------------------
Private Function Keyboard_IO(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Keyboard_IO = CallNextHookEx(mhKeyboardHook, nCode, wParam, lParam)
    mlIdleTime = 0
End Function

'--------------------------------------------------------------------------
' Procedure:    IncrementIdleTime
' Purpose:      Call this every second.  This routine will return the
'               the number of seconds this application has been idle.
'--------------------------------------------------------------------------
Public Function IncrementIdleTime() As Long
    mlIdleTime = mlIdleTime + 1
    IncrementIdleTime = mlIdleTime
End Function

Create a form with a CommandButton, a Textbox and a Timer on it and then paste in the following code:

Option Explicit

Private Sub Form_Load()
    Call IdleHook
    Timer1.Interval = 1000
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call IdleUnhook
End Sub

Private Sub Timer1_Timer()
    Dim lIdle As Long
   
    lIdle = IncrementIdleTime
    Me.Caption = "Idle = " & lIdle
End Sub

Run the program and place the mouse pointer on the taskbar at the bottom of your monitor and watch the idle time count up.
Then place the mouse pointer on the form itself and it will increment to a small number and then reset to 0.  Clearly it is not computing the idle time correctly when the mouse pointer is over the form.

 

Dear Idle Mind,

One more question if you don't mind.  In the Mouse_IO and Keyboard_IO routines, why did you make these modifications?

I just compiled the application with the modifications that you have suggested.  Unfortunately, I get the same results as before, the idle counter stops counting up when the mouse pointer is over the window.

Thank you again,
Michael