TraciShultz
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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)
ASKER
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...
ASKER
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.AppElapsedTi me)
End Sub
Private Sub Command2_Click()
Command2.Caption = "GetSys = " & CStr(IdleTime.SystemElapse dTime)
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(rl Time As Long)
Label3.Caption = "Elapsed App Time " & CStr(rlTime)
End Sub
Private Sub IdleTime_ElapsedSysTime(rl Time 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
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
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.AppElapsedTi
End Sub
Private Sub Command2_Click()
Command2.Caption = "GetSys = " & CStr(IdleTime.SystemElapse
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(rl
Label3.Caption = "Elapsed App Time " & CStr(rlTime)
End Sub
Private Sub IdleTime_ElapsedSysTime(rl
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!!
Great job!!
ASKER
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.