Link to home
Start Free TrialLog in
Avatar of TraciShultz
TraciShultzFlag for United States of America

asked on

How do you determine idle time by application?

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
SOLUTION
Avatar of scottmichael2
scottmichael2

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of TraciShultz

ASKER

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.
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Avatar of Ark
Ark
Flag of Russian Federation image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of scottmichael2
scottmichael2

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

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)

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...
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
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!!