Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Detect the length of time the system has not been used/ user is idle 1

Status
Not open for further replies.
GoldenFireTiger

GoldenFireTiger

MIS
Feb 19, 2005
47
0
0
GB
I want fdlgExitNonUse to be displayed when the user is idle for fifteen minutes. I have created a form called frmDetectIdleTime, and set the timer interval to 5000 for this. I have the following code behind the on timer function of this form:

Private Sub Form_Timer()

Const IDLEMINUTES = 15
Static PrevControlName As String
Static PrevFormName As String
Static ExpiredTime

Dim ActiveFormName As String
Dim ActiveControlName As String
Dim ExpiredMinutes

On Error Resume Next

ActiveFormName = Screen.ActiveForm.Name
If Err Then
ActiveFormName = "No Active Form"
Err = 0
End If

ActiveControlName = Screen.ActiveControl.Name
If Err Then
ActiveControlName = "No Active Control"
Err = 0
End If

If (PrevControlName = "") Or (PrevFormName = "") Or (ActiveFormName <> PrevFormName) Or (ActiveControlName <> PrevControlName) Then
PrevControlName = ActiveControlName
PrevFormName = ActiveFormName
ExpiredTime = 0
Else

ExpiredTime = ExpiredTime + Me.TimerInterval
End If

ExpiredMinutes = (ExpiredTime / 1000) / 60
If ExpiredMinutes >= IDLEMINUTES Then
ExpiredTime = 0

IdleTimeDetected ExpiredMinutes
End If
End Sub

Sub IdleTimeDetected(ExpiredMinutes)
'Dim Msg As String
'Msg = "No user activity detected in the last "
'Msg = Msg & ExpiredMinutes & " minute(s)!"
'MsgBox Msg, 48
DoCmd.OpenForm "fdlgExitNonUse"

End Sub

However, I have left the system running for fifteen minutes and nothing happens. Is there a reason for this? Can anyone see where I have gone wrong? Any help is greatly appreciated. Thank you.

 
Sort by date Sort by votes
There is an API function that can determine if the system is idle, but it is only compatible with Windows 2000 and later. If you're using Windows 2000 or Windows XP you can use the [tt]GetLastInputInfo()[/tt] function to determine if the user has used the keyboard or mouse.

You can check the mouse coordinates and the keyboard state without using a message hook, and you wouldn't need frequent checks to determine if the system is idle.

If you used a class module and loaded it with your switchboard or main form, you could set the TimerInterval of the form to around 10,000 and it would check every 10 seconds.

Here's a sample class that supports events, which can be used to tell the form if the system has been idle for the specified number of minutes:
Code: 
[green]'@--------------------------------------------------------------@
'@
'@  §lamKeys §oftware 2005® (VBSlammer)
'@
'@              :
'@  @FILENAME   :   -clsIdle.cls
'@  @CREATED    :   -2/24/2005 12:55:32 AM
'@  @PURPOSE    :   -Determine if user has used the keyboard or moved the mouse
'@              :
'@  @USAGE      :   Private WithEvents mIdle As clsIdle
'@              :
'@              :   Private Sub Form_Load()
'@              :     Set mIdle = New clsIdle
'@              :
'@              :     With mIdle
'@              :       .TimeOutMinutes = 10
'@              :       .StartCheckingIdleTime
'@              :     End With
'@              :   End Sub
'@              :
'@              :   Private Sub Form_Timer()
'@              :     mIdle.CheckInput
'@              :   End Sub
'@              :
'@              :   Private Sub mIdle_MaxIdleTimeDetected(ByVal dtTimeOccurred As Date)
'@              :     If MsgBox("The system has been idle for " & mIdle.ElapsedMinutes & _
'@              :               " minutes, would you like to continue working?", _
'@              :               vbQuestion + vbYesNo, "System Idle") = vbYes Then
'@              :       mIdle.Reset
'@              :     Else
'@              :       mIdle.StopCheckingIdleTime
'@              :     End If
'@              :   End Sub
'@              :
'@              :
'@  @REFERENCES :   -user32.dll
'@              :
'@  @NOTES      :   -Form's TimerInterval can be set high, such as 10,000 for 10 seconds.
'@              :
'@              :
'@  @NOTICE     :   -Open Source for public use - no warranty implied.
'@              :   -Include this header with distributed source.
'@              :
'@--------------------------------------------------------------@[/green]

Option Compare Database
Option Explicit

[green]'@---------------------- API Functions -------------------------@[/green]

Private Declare Sub GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI)
Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer

[green]'@------------------------- Events -----------------------------@[/green]

Public Event InputDetected(ByVal dtTimeOccurred As Date)
Public Event MaxIdleTimeDetected(ByVal dtTimeOccurred As Date)

[green]'@------------------------ Variables ---------------------------@[/green]

Private mlngTimeOutMinutes As Long
Private mdtStartTime As Date
Private mblnPaused As Boolean
Private mPosOld As POINTAPI
Private mPosNew As POINTAPI

[green]'@-------------------------- Types -----------------------------@[/green]

Private Type POINTAPI
  x As Integer
  y As Integer
End Type

[green]'@----------------------- Constructor --------------------------@[/green]

Private Sub Class_Initialize()
  TimeOutMinutes = 15   [green]'default timeout[/green]
End Sub

[green]'@----------------------- Properties ---------------------------@[/green]

Public Property Get TimeOutMinutes() As Long
  TimeOutMinutes = mlngTimeOutMinutes
End Property

Public Property Let TimeOutMinutes(ByVal lngTimeOutMinutes As Long)
  mlngTimeOutMinutes = lngTimeOutMinutes
End Property

Public Property Get StartTime() As Date
  StartTime = mdtStartTime
End Property

Private Property Let StartTime(ByVal dtStartTime As Date)
  mdtStartTime = dtStartTime
End Property

Public Property Get ElapsedMinutes() As Long
  ElapsedMinutes = DateDiff("n", StartTime, Now)
End Property

Public Property Get Paused() As Boolean
  Paused = mblnPaused
End Property

Public Property Let Paused(ByVal blnPaused As Boolean)
  mblnPaused = blnPaused
End Property

[green]'@---------------------- Public Methods ------------------------@[/green]

Public Sub CheckInput()
  If Paused Then Exit Sub
  
  If Not CheckMouseMoved() Then
    If Not CheckKeyboardUsed() Then
      Call UpdateElapsedTime
      Exit Sub
    End If
  End If
  
  Call Reset
  RaiseEvent InputDetected(Now)
End Sub

Public Sub StartCheckingIdleTime()
  Call Reset
  Paused = False
End Sub

Public Sub StopCheckingIdleTime()
  Paused = True
End Sub

Public Sub Reset()
  mPosNew.x = 0
  mPosNew.y = 0
  mPosOld.x = 0
  mPosOld.y = 0
  StartTime = Now
End Sub

[green]'@--------------------- Private Methods ------------------------@[/green]

Private Sub UpdateElapsedTime()
  If ElapsedMinutes >= TimeOutMinutes Then
    RaiseEvent MaxIdleTimeDetected(Now)
  End If
End Sub

Private Function CheckMouseMoved() As Boolean
  Call GetCursorPos(mPosNew)
  
  If ((mPosNew.x <> mPosOld.x) And (mPosNew.y <> mPosOld.y)) Then
    mPosOld.x = mPosNew.x
    mPosOld.y = mPosNew.y
    CheckMouseMoved = True
  End If
End Function

Private Function CheckKeyboardUsed() As Boolean
  Dim lngKey As Long
  
  For lngKey = 0 To 255
    If (GetAsyncKeyState(lngKey) And &H1) <> 0 Then
      CheckKeyboardUsed = True
      Exit For
    End If
  Next lngKey
End Function

[green]'@----------------------- End of Class -------------------------@[/green]

VBSlammer
redinvader3walking.gif

"You just have to know which screws to turn." - Professor Bob
 
Upvote 0 Downvote
I found a problem with the POINTAPI structure I included in the class, it should use Long data types instead of Integers, and doesn't return the y-coordinates properly as a result. I also used an "And" in the CheckMouseMoved function when it really should be an "Or" since moving in either direction indicates movement. Here's the updated code (with some other improvements):
Code: 
Option Compare Database
Option Explicit

[green]'@---------------------- API Functions -------------------------@[/green]

Private Declare [red]Function[/red] GetCursorPos Lib "user32" (lpPoint As POINTAPI) [red]As Long[/red]
Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer

[green]'@------------------------- Events -----------------------------@[/green]

Public Event InputDetected(ByVal dtTimeOccurred As Date)
Public Event MaxIdleTimeDetected(ByVal dtTimeOccurred As Date)

[green]'@------------------------ Variables ---------------------------@[/green]

Private mlngTimeOutMinutes As Long
Private mdtStartTime As Date
Private mblnPaused As Boolean
Private mPosOld As POINTAPI
Private mPosNew As POINTAPI

[green]'@-------------------------- Types -----------------------------@[/green]

Private Type POINTAPI
  x As [red]Long[/red]
  y As [red]Long[/red]
End Type

[green]'@----------------------- Constructor --------------------------@[/green]

Private Sub Class_Initialize()
  TimeOutMinutes = 15   [green]'default timeout[/green]
End Sub

[green]'@----------------------- Properties ---------------------------@[/green]

Public Property Get TimeOutMinutes() As Long
  TimeOutMinutes = mlngTimeOutMinutes
End Property

Public Property Let TimeOutMinutes(ByVal lngTimeOutMinutes As Long)
  mlngTimeOutMinutes = lngTimeOutMinutes
End Property

Public Property Get StartTime() As Date
  StartTime = mdtStartTime
End Property

Private Property Let StartTime(ByVal dtStartTime As Date)
  mdtStartTime = dtStartTime
End Property

Public Property Get ElapsedMinutes() As Long
  ElapsedMinutes = DateDiff("[red]s[/red]", StartTime, Now) [red]\ 60[/red]
End Property

Public Property Get Paused() As Boolean
  Paused = mblnPaused
End Property

Public Property Let Paused(ByVal blnPaused As Boolean)
  mblnPaused = blnPaused
End Property

[green]'@---------------------- Public Methods ------------------------@[/green]

Public Sub CheckInput()
  If Paused Then Exit Sub
  
  If Not CheckMouseMoved() Then
    If Not CheckKeyboardUsed() Then
      Call UpdateElapsedTime
      Exit Sub
    End If
  End If
  
  Call Reset
  RaiseEvent InputDetected(Now)
End Sub

Public Sub StartCheckingIdleTime()
  Call Reset
  Paused = False
End Sub

Public Sub StopCheckingIdleTime()
  Paused = True
End Sub

Public Sub Reset()
  [red]If GetCursorPos(mPosNew) <> 0 Then
    mPosOld.x = mPosNew.x
    mPosOld.y = mPosNew.y
  End If[/red]
  StartTime = Now
End Sub

[green]'@--------------------- Private Methods ------------------------@[/green]

Private Sub UpdateElapsedTime()
  If ElapsedMinutes >= TimeOutMinutes Then
    RaiseEvent MaxIdleTimeDetected(Now)
  End If
End Sub

Private Function CheckMouseMoved() As Boolean
  [red]If[/red] GetCursorPos(mPosNew) [red]= 0 Then Exit Function[/red]
  
  If ((mPosNew.x <> mPosOld.x) [red]Or[/red] (mPosNew.y <> mPosOld.y)) Then
    mPosOld.x = mPosNew.x
    mPosOld.y = mPosNew.y
    CheckMouseMoved = True
  End If
End Function

Private Function CheckKeyboardUsed() As Boolean
  Dim lngKey As Long
  
  For lngKey = 0 To 255
    If (GetAsyncKeyState(lngKey) And [red]&H8001[/red]) <> 0 Then
      CheckKeyboardUsed = True
    End If
  Next lngKey
End Function

[green]'@----------------------- End of Class -------------------------@[/green]

VBSlammer
redinvader3walking.gif

"You just have to know which screws to turn." - Professor Bob
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Moss100
  • Locked
  • Question
Remove everything including the comma from the last comma of a string. 1
Replies
10
Views
303
Andrzejek
Andrzejek
Moss100
  • Locked
  • Question
Stop user changing size of Access Application (not form)
Replies
1
Views
263
Andrzejek
Andrzejek
Drago1920
  • Locked
  • Question
Finding the lowest date
Replies
2
Views
179
Andrzejek
Andrzejek
Moss100
  • Locked
  • Question
Open New Access Database and Maximise the Application Window
Replies
0
Views
214
Moss100
Moss100
M
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
159
SoftwareRT
SoftwareRT

Part and Inventory Search

Sponsor

Back
Top