Solved

How do you determine idle time by application?

Posted on 2007-03-21
9
1,107 Views
Last Modified: 2008-02-01
Hi all you experts,

I need to determine the idle time of my application in order to re-prompt the user for a login...
That being said I found a good way to test for system idle time using GetLastInputInfo  API.
I am sure there is a way to also add the handle to the application so I am only tracking my applications idle time?

Any help is greatly appreciated. We are currently coding this in VB 6.0...

Thanks

Traci
0
Comment
Question by:TraciShultz
  • 3
  • 3
  • 2
  • +1
9 Comments
 
LVL 1

Assisted Solution

by:scottmichael2
scottmichael2 earned 166 total points
ID: 18766699
I'm sure you already know that GetLastInputInfo is system wide.  I'm not sure that there is a similar API call that is specific to the application.

You might want to check out this article:
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=63195&lngWId=1

It talks about keyboard hooks, and you can also apply it to mouse hooks.  Basically, you are monitoring system-wide keyboard events, but only capturing data from them if your application has the foreground.

Another option might be to trap all keypress and mousedown events for each control on your form.  Whenever the event fires, set a Date variable to the system date (time) that it fired.  Then use a Timer control to check the last time something fired with the current system time (set the Timer's Interval to however long your idle time should be).  This is a bit tedious, but it should work.  
0
 

Author Comment

by:TraciShultz
ID: 18766918
yes,
Our application has about 50-100 separate OCX's and I really don't want to add code to each one. This would break compatibility to some legacy stuff... I looked into the link you suggested and it could work but for now unless anyone has a simple API idea I think I'll stick with the system wide approach and see if it satisfies our needs.

Thanks for the input.
0
 
LVL 13

Accepted Solution

by:
Mark_FreeSoftware earned 167 total points
ID: 18775308

try setting the keypreview of the form to true,

if all goes well, all keys should be passing in the form_keypress now...

please note that some ocx's break this issue by accident (or by design)
0
 
LVL 27

Assisted Solution

by:Ark
Ark earned 167 total points
ID: 18775402
Take a look on my sample at http://www.freevbcode.com/ShowCode.Asp?ID=3297 - "Check if an Application is Idle for a Period of Time"
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 1

Expert Comment

by:scottmichael2
ID: 18779260
Yep, that was one little detail that I forgot Mark!  Set the KeyPreview to True for your form.  Here is some sample code to get you started (wrote it real quick so definitely needs tweaking, debugging, etc.)...

Option Explicit

Private mdteLastAction As Date

Private Sub Command1_Click()
    MsgBox GetTimeDiff
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    mdteLastAction = Now
End Sub

Private Sub Form_Load()
    mdteLastAction = Now
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mdteLastAction = Now
End Sub

Private Function GetTimeDiff() As Integer
    GetTimeDiff = DateDiff("s", mdteLastAction, Now)
End Function
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 18779787

or what is even easier (and requires less processing)

set the interval of the timer to 6000 (one second)

create a long that is declared global,

and every time the timer fires, add 1 to the current value of the long

now if there is a keypress or so, set the long to 0 (zero)

0
 

Author Comment

by:TraciShultz
ID: 18779828
I would like to thank everyone for there imput. I am currently putting a class to gether that implements both the App only Idle time and the system Idle time. When I have completed it I will post my solution. Stay tuned...
0
 

Author Comment

by:TraciShultz
ID: 18780665
Thank you everyone for heloping me attain my solution.
Ok Guys here is my solution:
Please feel free to comment. I created a class that allows to set the MaxTimeOut and allow you to decide if you want to monitor your app only, or systsemwide only or both. The only other public function is StartMonitor.

In the class I am using Codeflow as my timer, so If you want to use this code in a form without the class you can use a standard windows timer.

*** class code ****
Option Explicit

Private Type LASTINPUTINFO
   cbSize As Long
   dwTime As Long
End Type

Public Enum eMonitorType
   AppOnly = 1
   SystemOnly = 2
   AppAndSystem = 3
End Enum

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetLastInputInfo Lib "user32" (plii As Any) 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)

Private WithEvents tccf As TCCodeFlow.objTimer

Public Event TimeOut()
Public Event AppTimeOut()
Public Event ElapsedSysTime(rlTime As Long)
Public Event ElapsedAppTime(rlTime As Long)

Private mlSystemElapsedTime As Long
Private mlMaxTimeOut As Long
Private mt As Long
Private m_objMonitorType As eMonitorType
Private m_lngAppElapsedTime As Long
Public Property Get AppElapsedTime() As Long

    On Error GoTo EH
    AppElapsedTime = m_lngAppElapsedTime


EH:
    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , AppElapsedTime Err = " & Err.Description
    End If
   
End Property
Public Property Let AppElapsedTime(vData As Long)

    On Error GoTo EH
    m_lngAppElapsedTime = vData


EH:
    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , AppElapsedTime Err = " & Err.Description
    End If
   
End Property


Public Property Get MonitorType() As eMonitorType

    On Error GoTo EH
    MonitorType = m_objMonitorType


EH:
    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , MonitorType Err = " & Err.Description
    End If
   
End Property
Public Property Let MonitorType(vData As eMonitorType)

    On Error GoTo EH
    m_objMonitorType = vData


EH:
    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , MonitorType Err = " & Err.Description
    End If
   
End Property

Public Sub StartMonitor()
   On Error GoTo EH

   If mlMaxTimeOut > 0 Then
      mt = Timer
      tccf.Enabled = True
   End If

EH:
    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , StartMonitor Err = " & Err.Description
    End If
End Sub

Public Property Get MaxTimeOut() As Long

   On Error GoTo EH
   MaxTimeOut = mlMaxTimeOut
   
EH:
   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , MaxTimeOut Err = " & Err.Description
   End If
   
End Property
Public Property Let MaxTimeOut(vData As Long)
   
   On Error GoTo EH
   mlMaxTimeOut = vData
   
EH:
   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , MaxTimeOut Err = " & Err.Description
   End If
End Property


Public Property Get SystemElapsedTime() As Long
   
   On Error GoTo EH
   SystemElapsedTime = mlSystemElapsedTime
   
EH:
   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , SystemElapsedTime Err = " & Err.Description
   End If
   
End Property


Private Sub Class_Initialize()
   Set tccf = New TCCodeFlow.objTimer
   tccf.Interval = 10
   tccf.Enabled = False
   MonitorType = AppOnly
End Sub

Private Sub Class_Terminate()
   tccf.Enabled = False
   Set tccf = Nothing
End Sub

Private Function SystemIdleTime() As Long
   Dim lii As LASTINPUTINFO
   
   On Error GoTo EH
   
   lii.cbSize = Len(lii)
   Call GetLastInputInfo(lii)
   mlSystemElapsedTime = FormatNumber((GetTickCount() - lii.dwTime) / 1000, 2)
   SystemIdleTime = mlSystemElapsedTime
   
EH:
   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , SystemIdleTime Err = " & Err.Description
   End If
   
End Function


Private Function AppIdleTime() As Long
   Dim t As Long
   
   If GetQueueStatus(QS_INPUT) Then
      mt = Timer
   Else
      t = Timer
      m_lngAppElapsedTime = CLng((t - mt))
      AppIdleTime = m_lngAppElapsedTime
   End If
EH:
   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, "EXCEPTION: clsIdleTime , AppIdleTime Err = " & Err.Description
   End If
End Function

Private Sub tccf_Timer()
Static bSys As Boolean
Static bApp As Boolean
Dim lTime As Long
   
   Select Case m_objMonitorType
      Case 1
         If bApp = False Then
            lTime = CLng(AppIdleTime)
            If lTime > mlMaxTimeOut Then
               bApp = True
               RaiseEvent AppTimeOut
            Else
               RaiseEvent ElapsedAppTime(lTime)
            End If
         End If
         If bApp = True Then tccf.Enabled = False 'AppOnly
      Case 2
         If bSys = False Then
            lTime = SystemIdleTime
            If lTime > mlMaxTimeOut Then
               bSys = True
               RaiseEvent TimeOut
            Else
               RaiseEvent ElapsedSysTime(lTime)
            End If
         End If
         If bSys = True Then tccf.Enabled = False 'SystemOnly
      Case 3
         If bApp = False Then
            lTime = CLng(AppIdleTime)
            If lTime > mlMaxTimeOut Then
               bApp = True
               RaiseEvent AppTimeOut
            Else
               RaiseEvent ElapsedAppTime(lTime)
            End If
         End If
         
         If bSys = False Then
            lTime = SystemIdleTime
            If lTime > mlMaxTimeOut Then
               bSys = True
               RaiseEvent TimeOut
            Else
               RaiseEvent ElapsedSysTime(lTime)
            End If
         End If
         If bSys And bApp = True Then tccf.Enabled = False  'AppAndSystem
   End Select
End Sub

**********************************************************************
In order to test this class I creted an application with 4 labels and 2 buttons.

Below is the code from the form:
*******************************************************************************************
Public WithEvents IdleTime              As clsIdleTime

Private Sub Command1_Click()
   Command1.Caption = "GetApp = " & CStr(IdleTime.AppElapsedTime)
End Sub

Private Sub Command2_Click()
   Command2.Caption = "GetSys = " & CStr(IdleTime.SystemElapsedTime)
End Sub

Private Sub Form_Load()
   Set IdleTime = New clsIdleTime
   IdleTime.MaxTimeOut = 10
   IdleTime.MonitorType = AppAndSystem
   Me.Caption = "App and System" & " TimeOut = " & IdleTime.MaxTimeOut
   IdleTime.StartMonitor
End Sub

Private Sub IdleTime_AppTimeOut()
   Me.Label1.Caption = "AppTimeOut"
End Sub

Private Sub IdleTime_ElapsedAppTime(rlTime As Long)
   Label3.Caption = "Elapsed App Time " & CStr(rlTime)
End Sub

Private Sub IdleTime_ElapsedSysTime(rlTime As Long)
   Label4.Caption = "Elapsed System Time " & CStr(rlTime)
End Sub

Private Sub IdleTime_TimeOut()
   Me.Label2.Caption = "SysTimeOut"
End Sub

In order to user the class I created a monule so the appication could be set as an Active X and Startup is from a sub main()

' **************************************************
' Modmain
Public goForm1 As Form1

Public Sub main()
   Set goForm1 = New Form1
   Form1.Show
End Sub
0
 
LVL 1

Expert Comment

by:scottmichael2
ID: 18782152
Very nice.  I thought that the GetQueueStatus call was at the system level, but I was wrong (it deals with only messages in the calling thread).  Furthermore, your code is much more eloquent than what I posted :-)

Great job!!
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now