Exit VB program if user idle in a period of time

Greetings to all,

I'm using "GetQueueStatus" function to check user idle in a period of time.
My VB program seem like hang if go to other program, and then come back to
VB program. This is because I'm using Do...Loop statement causing the program
running non-stop I'm suspecting. But if I don't loop, I can't check user
idle in a period of time. I called "CheckInputIdle" subroutine in Form_Activate().
Do you have any suggestion? Below are my codes.

regards,
KS


============
Declarations
============

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)

Public bCancel As Boolean

====
Code
====

Public Sub CheckInputIdle(ByVal TimeOut_InSec As Long)
Dim t As Long
t = Timer
Do While bCancel = False
If GetQueueStatus(QS_INPUT) Then
t = Timer
DoEvents
End If
If Timer - t >= TimeOut_InSec Then Exit Do
Loop
If bCancel = False Then MsgBox "Process idle is for " & Timer - t & " sec."
End Sub

KS,

Place the following code in a module. I'm afraid you will have to find the API declares yourself (I use type libraries).

Public glIdleTime as Long

'--- API Wrap ---
Public Sub Hook()
mhMouseHook = ApiRaiseIfNull(SetWindowsHookEx(WH_MOUSE, _
AddressOf Mouse_IO, 0&, App.ThreadID))
mhKeyboardHook = ApiRaiseIfNull(SetWindowsHookEx(WH_KEYBOARD, _
AddressOf Keyboard_IO, 0&, App.ThreadID))
End Sub

Public Sub Unhook()
ApiRaiseIfNull UnhookWindowsHookEx(mhMouseHook)
ApiRaiseIfNull UnhookWindowsHookEx(mhKeyboardHook)
End Sub

'--- End of API Wrap ---


'--- Api Callbacks ---
Private Function Mouse_IO(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Mouse_IO = CallNextHookEx(mhMouseHook, nCode, wParam, lParam)
glIdleTime = 0 'we've had activity, so reset ticks
End Function

Private Function Keyboard_IO(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Keyboard_IO = CallNextHookEx(mhKeyboardHook, nCode, wParam, lParam)
glIdleTime = 0
End Function


When you want to track idle time call the above Hook and start a timer on the form to fire say every 10 seconds. In each timer event increment glIdleTime by 10. When ever you want to check how long the user has been idle check the value of glIdleTime. Be sure to call Unhook when you are closing down.

How does this work? The windows hook mechanism allows you to preview messages going to any window. In the case of VB you are limited to windows with in your own app but that's what we want. In this case we are not interested in the messages themselves just that there were some. Hence by hooking the keyboard and the mouse we can determine if the user is active in the app.

I have just presented the basics here. In my ildle timer module I also use SetTimer/KillTimer APIs along with a TimerProc call back function to eliminate dependence on a timer control.

--
Anthony Jones
Nuesoft Ltd

fd
"KS" <ksyap@ebworx.com> wrote in message news:3c71ffbd$1@10.1.10.29...
>
> Greetings to all,
>
> I'm using "GetQueueStatus" function to check user idle in a period of
time.
> My VB program seem like hang if go to other program, and then come back to
> VB program. This is because I'm using Do...Loop statement causing the
program
> running non-stop I'm suspecting. But if I don't loop, I can't check user
> idle in a period of time. I called "CheckInputIdle" subroutine in
Form_Activate().
> Do you have any suggestion? Below are my codes.
>
> regards,
> KS
>
>
> ============
> Declarations
> ============
>
> 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)
>
> Public bCancel As Boolean
>
> ====
> Code
> ====
>
> Public Sub CheckInputIdle(ByVal TimeOut_InSec As Long)
> Dim t As Long
> t = Timer
> Do While bCancel = False
> If GetQueueStatus(QS_INPUT) Then
> t = Timer
> DoEvents
> End If
> If Timer - t >= TimeOut_InSec Then Exit Do
> Loop
> If bCancel = False Then MsgBox "Process idle is for " & Timer - t & "
sec."
> End Sub
>
>
>

Sorry for that. My keyboard got stuck.....

I was going to say to put a Doevents, but you already got that. So now, I'm
going to ask you why you want to do this? It's contra-intuitive. Windows
programs don't kill themselves. Furthermore, you are doing socalled 'busy
waiting' which is very inefficient and slows other programs down. From what
you describe it looks like the Doevents is never executed.
A discussion about this very approach was done a couple of months ago here
and the outcome was that it was too much trouble and to cumbersome and that
the purpose of the whole exercise was unclear...........

hth
huibert

"Huibert" <hvandeursen@wanadoo.nl> wrote in message
news:3c752dc3@10.1.10.29...
> fd
> "KS" <ksyap@ebworx.com> wrote in message news:3c71ffbd$1@10.1.10.29...
> >
> > Greetings to all,
> >
> > I'm using "GetQueueStatus" function to check user idle in a period of
> time.
> > My VB program seem like hang if go to other program, and then come back
to
> > VB program. This is because I'm using Do...Loop statement causing the
> program
> > running non-stop I'm suspecting. But if I don't loop, I can't check user
> > idle in a period of time. I called "CheckInputIdle" subroutine in
> Form_Activate().
> > Do you have any suggestion? Below are my codes.
> >
> > regards,
> > KS
> >
> >
> > ============
> > Declarations
> > ============
> >
> > 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)
> >
> > Public bCancel As Boolean
> >
> > ====
> > Code
> > ====
> >
> > Public Sub CheckInputIdle(ByVal TimeOut_InSec As Long)
> > Dim t As Long
> > t = Timer
> > Do While bCancel = False
> > If GetQueueStatus(QS_INPUT) Then
> > t = Timer
> > DoEvents
> > End If
> > If Timer - t >= TimeOut_InSec Then Exit Do
> > Loop
> > If bCancel = False Then MsgBox "Process idle is for " & Timer - t & "
> sec."
> > End Sub
> >
> >
> >
>
>

>Windows programs don't kill themselves.

Why? Is there some law?

I have had to write programs where the client has specifically required this
function.
What should I have told them; "I'm sorry but Windows programs don't do that"
??


--
Anthony Jones
Nuesoft Ltd

"KS" <ksyap@ebworx.com> wrote in message <news:3c71ffbd$1@10.1.10.29>...

> Greetings to all,
>
> I'm using "GetQueueStatus" function to check user idle in a period of time.
> My VB program seem like hang if go to other program, and then come back to
> VB program. This is because I'm using Do...Loop statement causing the program
> running non-stop I'm suspecting. But if I don't loop, I can't check user
> idle in a period of time. I called "CheckInputIdle" subroutine in Form_Activate().

What exactly is meant by "idle"? Will the user's switching to another
app and using that instead count as "idle", or are you only talking
about the sort of "idle" that causes screen-savers to launch?

Do you use modal forms and ActiveX components that might themselves
display modal windows? If not, perhaps you could set KeyPreview to
True and hook the KeyDown and MouseMove events in your forms to update
a magic timer:

Global LastUsed As Date

Private Sub ToraToraTora()
Static Busy As Boolean
If Busy Then Exit Sub Else Busy = True

PlaySound App.Path & "\Surfaris - Wipe Out.wav"

While Forms.Count > 0
Unload Forms(Forms.Count - 1)
Wend

Busy = False
End Sub

' the initial Interval should be 65535 or thereabouts
Private Sub Doomsday_Timer()

Const Timeout = 60 * 15 ' 15 minutes

Dim Remaining As Long
Remaining = Timeout - DateDiff("s", LastUsed, Now)

If Remaining > 65 Then
Doomsday.Interval = 65000

ElseIf Remaining > 0 Then
Doomsday.Interval = Remaining * 1000

Else
ToraToraTora
End If
End Sub

' we shouldn't have to hook every form's KeyPress too
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
LastUsed = Now
End Sub

' too bad there's no MousePreview property as well!
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LastUsed = Now
End Sub

--
Joe Foster <mailto:jlfoster%40znet.com> Sign the Check! <http://www.xenu.net/>
WARNING: I cannot be held responsible for the above They're coming to
because my cats have apparently learned to type. take me away, ha ha!

Sounds real complicated.

What advantages does it have over a Mouse and Keyboard hook?

When would you call MsgWaitForMultipleObjects? When the app goes idle? If
so how do you know when the app is idle?

I'm struggling to see how this could work at all.

--
Anthony Jones
Nuesoft Ltd

I can think of a few reasons to do this including security and batch type
processing. Hey user left critical app open shut it and tell their boss
or hmm we need to do nightly update but need exclusive access to a table
that Joe has open using app haha but Joe left for the week and just left
his computer on and programs open.

Actually this is realtivly easy to do using the createevent apis and the
MsgWaitForMultipleObjects api.. you can set the wait function to wait x amount
of time if nothing has happened during that close your program. Nice thing
about this is puts your program into a very low cpu usage if nothing is going
on in the program, unlike the do- doevents-loop process, and great for timed
msgboxes and such. Set the wakemask to whatever will guide you program (i
usally set it to all with vb/com use but I using it for events). You could
even add a query msg to check status just make sure you reset the wait correctly.
you also need to put a doevents in the case when the input flag is set.
I use this for a very light weight timer since I don't always trust the systimer
functions for proper shutdown and they cause great pains to the system if
they don't.. another option is to subclass a form window and check if any
of the appropriate keyboard or mouse mssgs come through.



"Anthony Jones" <anthony.jones@nonuesoft.spamco.uk> wrote:
>>Windows programs don't kill themselves.
>
>Why? Is there some law?
>
>I have had to write programs where the client has specifically required
this
>function.
>What should I have told them; "I'm sorry but Windows programs don't do that"
>??
>
>
>--
>Anthony Jones
>Nuesoft Ltd
>
>