Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


Enforce a session timeout for users

Posted on 2002-04-30
Medium Priority
Last Modified: 2010-05-02
I am building an application in VB6 and need to be able to detect if a user's session has been idle for 20 minutes.

I found a question on EE which dealt with something similar and TravisHall provided the following code:

=====Code to go in main form called frmEditor=======

'Declarations section
Private mhActivityEvent As Long
Private mhSignalLoopThread As Long

Private Sub Form_Load()
mhActivityEvent = CreateEvent(0, 0, 0, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
If mhSignalLoopThread <> 0 Then CloseHandle mhSignalLoopThread
CloseHandle mhActivityEvent
End Sub

======Code from the mdiTimers module:===========

Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As Long) As Long
Public Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Any, ByRef lpParameter As Any, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, pHandles As Long, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long
Private Const WAIT_ABANDONED_0& = &H80&
Private Const WAIT_OBJECT_0& = 0
Private Const WAIT_TIMEOUT& = &H102&
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE _
                           Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE _
                           Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT _
                           Or QS_POSTMESSAGE _
                           Or QS_TIMER _
                           Or QS_PAINT _
                           Or QS_HOTKEY)
                           Or QS_PAINT _
                           Or QS_TIMER _
                           Or QS_POSTMESSAGE _
                           Or QS_MOUSEBUTTON _
                           Or QS_MOUSEMOVE _
                           Or QS_HOTKEY _
                           Or QS_KEY)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Public Const WM_USER = &H400

Public Sub SignalLoop(ByRef hEvent As Long)
Dim lRet As Long

   lRet = MsgWaitForMultipleObjects(1, hEvent, 0, 50000, QS_ALLEVENTS Or QS_ALLINPUT)
   Select Case lRet
   Case WAIT_OBJECT_0 + 1
       MsgBox ("timeout")
       'SendMessage frmEditor.hwnd, WM_AUTOLOGOFF, 0, 0
       Exit Do
   End Select

End Sub

However, he suggests to subclass the frmEditor form in order to gain acces to the WM_AUTOLOGOFF message. I dont have any experience of subclassing forms and i have to admit a lot of the above code is alien to me.

if someone (ie TravisHall) could help me turn the above code into a working solution i would be very grateful!


ps. operating system is windows NT, 98 and 2000
Question by:RichBisset
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4

Expert Comment

ID: 6980207
Private Declare Sub GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Type POINTAPI
    x As Integer
    Y As Integer
End Type
Private posOld As POINTAPI
Private posNew As POINTAPI

Public Function InputCheck() As Boolean
    Dim i As Integer
    'take mouse coordinates as they are
    Call GetCursorPos(posNew)
    'compare them with the old values
    If ((posNew.x <> posOld.x) Or (posNew.Y <> posOld.Y)) Then
        posOld = posNew
        InputCheck = True
        Exit Function ' mouse is moved so user is activ
    End If
    Dim IntKeyValue As Integer 'key value
    For IntKeyValue = 8 To 126
        InputCheck = CBool(GetAsyncKeyState(Asc(Chr$(IntKeyValue))))
        If InputCheck Then
            Exit For
        End If
End Function

If this function returns true, system is not idle. If it returns false then it is idle.


Author Comment

ID: 6980875

I ran the above code and it did not return a value for the y axis of the mouse pointer position.

Expert Comment

ID: 6982568

Keep the above code in a Module i.e. .bas file.

Check the code like this

In your form put a timer control,

In your timer control, set the time for 20 Minutes


Private Sub Timer1_Timer()
 if not InputCheck then
    'System is idle for 20 mins
    'Place your code whatever you want.
 end if
End Sub



Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.


Author Comment

ID: 6982861
The code is working well apart from two problems.

firstly, no value is returned for the y axis of the mouse pointer position - it is always equal to 0.

secondly, if i use the Exit For statement in this function:

For IntKeyValue = 8 To 126
       InputCheck = CBool(GetAsyncKeyState(Asc(Chr$(IntKeyValue))))
       If InputCheck Then
           Exit For
       End If

...and press more than one key during the test, it exits the loop after the first key that has been pressed, but when it runs the function next time around it registers that the other key(s) were pressed.

for instance if i run a test and type in A,B,C between a single timer interval, the code above will quit after the 'A' key has found to have changed.

then if i dont press a key during the next interval, it will think that i have pressed the 'B' key. Then next interval it thinks i have pressed the 'C' key.

if i remove the exit for statement it works perfectly.


Expert Comment

ID: 6983181
Thanks RichBisset, I have not noticed that earlier.


Accepted Solution

n_narayanan earned 400 total points
ID: 6983183
Does my solution answer your problem?


Author Comment

ID: 6983370
The solution is close enough!

Thanks for the help

Author Comment

ID: 6996021
see last entry

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…
Suggested Courses

610 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