To see an easy-to-use class wrapper around this module you can download the class module at http://www.codeoftheweek.com/issues/issue102
Create a new module and paste this source code into it. You should name this class module basInactivity. If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: basInactivity
' Written By: C&D Programming Corp.
' Create Date: 8/99
' Copyright: Copyright 1999 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
' provide a link into the class to allow this module to raise an event when the
' inactivity time becomes true.
Private oInactivityWatch As cInactivtyWatch
' Windows hook stuff
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 Integer, lParam As Any) As Long
Private Const WH_KEYBOARD = 2
Private Const WH_MOUSE = 7
' Timer API
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
'============================================================================
Private mlInactivityDelay As Long ' in seconds
Private mlInactivityInterval As Long ' how often to check for inactivity in seconds (we
' recommend this is 5 seconds or less)
Private mhHookMouse As Long ' handle for mouse hook
Private mhHookKeyboard As Long ' handle for keyboard hook
Private mlTimerID As Long ' timer ID value
Private mbMouseActivity As Boolean ' flag set by any mouse activity
Private mbKeyboardActivity As Boolean ' flag set by any keyboard activity
Private dtMouseReference As Date ' last time of mouse activity
Private dtKeyboardReference As Date ' last time of keyboard activity
' some enumerators to make things easier.
Public Enum InactivityMode
imKeyboard
imMouse
End Enum
Public Function ActivityRef(eMode As InactivityMode) As Date
If eMode = imKeyboard Then
ActivityRef = dtKeyboardReference
End If
If eMode = imMouse Then
ActivityRef = dtMouseReference
End If
End Function
Public Sub SetParameters(o As cInactivtyWatch, lInactivityDelay As Long, lInactivityInterval As Long)
Set oInactivityWatch = o
mlInactivityDelay = lInactivityDelay
mlInactivityInterval = lInactivityInterval
End Sub
Public Function SetInactivityHook() As Boolean
On Error Goto Handler
' set mouse hook
If mhHookMouse = 0& Then 'not already set
mhHookMouse = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0&, App.ThreadID)
End If
' set keyboard hook
If mhHookKeyboard = 0& Then 'not already set
mhHookKeyboard = SetWindowsHookEx(WH_KEYBOARD, AddressOf KBProc, 0&, App.ThreadID)
End If
' initialize some variables
dtMouseReference = Now '
dtKeyboardReference = Now
mbKeyboardActivity = True 'initialize
mbMouseActivity = True 'initialize
If mlTimerID = 0& Then 'not already set
' take default of 5 seconds
If mlInactivityInterval = 0 Then
mlInactivityInterval = 5
End If
' this is a built-in limit of the settimer function (actually it is probably
' 65535, but we figured 60 seconds would be adequate for this application)
If mlInactivityInterval > 60 Then
mlInactivityInterval = 60
End If
mlTimerID = SetTimer(0&, 0&, mlInactivityInterval * 1000, AddressOf TimerProc)
End If
SetInactivityHook = True
Exit Function
Handler:
SetInactivityHook = False
Exit Function
End Function
Public Sub ResetInactivityHook()
Dim lRet As Long
If mlTimerID <> 0& Then
KillTimer 0&, mlTimerID
mlTimerID = 0&
End If
If mhHookMouse <> 0& Then 'not already unhooked
lRet = UnhookWindowsHookEx(mhHookMouse)
If lRet <> 0& Then mhHookMouse = 0&
End If
If mhHookKeyboard <> 0& Then 'not already unhooked
lRet = UnhookWindowsHookEx(mhHookKeyboard)
If lRet <> 0& Then mhHookKeyboard = 0&
End If
End Sub
Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
MouseProc = CallNextHookEx(mhHookMouse, nCode, wParam, lParam)
End If
mbMouseActivity = True
End Function
Private Function KBProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
KBProc = CallNextHookEx(mhHookKeyboard, nCode, wParam, lParam)
End If
mbKeyboardActivity = True
End Function
Private Function TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) As Long
' if we had activity, update our time reference and continue.
If mbKeyboardActivity Then
dtKeyboardReference = Now 'reset reference
mbKeyboardActivity = False
End If
If mbMouseActivity Then
dtMouseReference = Now 'reset reference
mbMouseActivity = False
End If
If Not mbMouseActivity And Not mbKeyboardActivity Then
'check for no activity
If (Abs(DateDiff("s", Now, dtMouseReference)) >= mlInactivityDelay) And _
Abs(DateDiff("s", Now, dtKeyboardReference)) >= mlInactivityDelay Then
oInactivityWatch.UserInactivity
' force counter to reset in case the user decides not to abort the
' exiting of this routine. This should happen anyway since the user
' would have to hit a key or move the mouse to cancel the operation.
mbKeyboardActivity = True
mbMouseActivity = True
End If
End If
End Function