Home Page Free Software CCTV Products CCTV Samples Local Services Offshore Services Contact Us

Computer Repair
Tel: 242-364-9183
Nassau, Bahamas
Bahamas Video Surveillance . Bahamas CCTV . Bahamas Infrared . Bahamas Digital Video . Bahamas Remote Video . Bahamas Burglar Alarm . Bahamas Technician
Bahamas Real Estate
Bahamas Yellow Pages


Free Software:


We Recommend:
MediaFire - Free File Hosting Made Simple
Follow us on:
Twitter Twitter


 

Idle Track Class

Tracks when the mouse is idle with an easy to use Class Module.
Download VB6 project. (12 downloads)

frmIdle.frm  - Example Form

Option Explicit

' =======================================================
' this example shows how to use system idle with a timer
' =======================================================
' when you are away from the system it will go idle mode
' when you move the mouse or touch a key system is active
' -------------------------------------------------------
' to manually reset user input in code: Call ResetInput
' =======================================================

Private WithEvents IdleTrack As cIdle
Attribute IdleTrack.VB_VarHelpID = -1

' program start
Private Sub Form_Load()
    Set IdleTrack = New cIdle            ' start class
    Call IdleTrack.StartIdle(Timer1, 10) ' timer|interval
End Sub

' program exit
Private Sub Form_Unload(Cancel As Integer)
    Set IdleTrack = Nothing              ' end class
End Sub

' active event
Private Sub IdleTrack_OnActive()
    Debug.Print "MY ACTIVE CODE"         ' active code
    Me.Show
End Sub

' idle event
Private Sub IdleTrack_OnIdle()
    Debug.Print "MY IDLE CODE"           ' idle code
    Me.Hide
End Sub

cIdle.cls - Idle Track Class

Option Explicit

Private Const KEYEVENTF_KEYUP = &H2
Private Const INPUT_KEYBOARD = 1

Private Type LASTINPUTINFO
   cbSize As Long
   dwTime As Long
End Type

Private Type KEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As Long
End Type

Private Type GENERALINPUT
    dwType As Long
    xi(0 To 23) As Byte
End Type

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetLastInputInfo Lib "user32" (plii As Any) As Long
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long

Public Event OnIdle()       ' idle event for form
Public Event OnActive()     ' active event for form

Private mIdleMode As Long   ' 1=idle, 2=active
Private mIdleCnt As Long    ' idle for count
Private mInterval As Long   ' interval, eg. 10 (secs)
Private WithEvents mTimer As Timer ' timer on form

' set idle mode
Public Property Let IdleMode(ByVal pIdleMode As Long)
    mIdleMode = pIdleMode
End Property

' get idle mode
Public Property Get IdleMode() As Long
    IdleMode = mIdleMode
End Property

' set idle for count
Public Property Let IdleCnt(ByVal pIdleCnt As Long)
    mIdleCnt = pIdleCnt
End Property

' get idle for count
Public Property Get IdleCnt() As Long
    IdleCnt = mIdleCnt
End Property

' start the idle mode
Public Sub StartIdle(pTimer As Timer, Optional ByVal pInterval As Long = 10)
On Error GoTo Error_Handler
    mIdleMode = 2
    If mTimer Is Nothing Then Set mTimer = pTimer
    mInterval = pInterval
    If Not mTimer Is Nothing Then
        mTimer.Interval = 1000 ' idle timer start
        mTimer.Enabled = True
        '=============================
        Debug.Print "IDLE TIMER START"
        '-----------------------------
        Exit Sub
    End If
Error_Handler:
    '=============================
    Debug.Print "IDLE START ERROR"
    '-----------------------------
End Sub

' reset the idle time
Public Sub ResetInput()
    'this is similar to send keys
    'just need to simulate user input
    'so no copy memory in this one
    Dim GInput(0) As GENERALINPUT
    Dim KInput As KEYBDINPUT
    KInput.wVk = vbKeyEscape
    GInput(0).dwType = INPUT_KEYBOARD
    Call SendInput(1, GInput(0), Len(GInput(0)))
    '=============================
    Debug.Print "RESET USER INPUT"
    '-----------------------------
End Sub

' raise the idle event
Public Sub RaiseIdle()
    RaiseEvent OnIdle
End Sub

' raise the active event
Public Sub RaiseActive()
    RaiseEvent OnActive
End Sub

' get and set idle modes
Private Function CheckIdle()
    mIdleCnt = IdleTime
    If mIdleCnt > mInterval Then ' idle
        If mIdleMode = 2 Then
            mIdleMode = 1
            '=============================
            Debug.Print "SYSTEM IS IDLE"
            '-----------------------------
            Call RaiseIdle
            '-----------------------------
        End If
    Else
        If mIdleMode = 1 Then ' active
            mIdleMode = 2
            '=============================
            Debug.Print "SYSTEM IS ACTIVE"
            '-----------------------------
            Call RaiseActive
            '-----------------------------
        End If
        If mIdleCnt > 0 Then
            '============================================
            Debug.Print "IDLE FOR: " & mIdleCnt & " secs"
            '--------------------------------------------
        End If
    End If
End Function

' timer event on form
Private Sub mTimer_Timer()
    Call CheckIdle
End Sub

' finish the idle mode
Private Sub FinishIdle()
    If Not mTimer Is Nothing Then
        mTimer.Interval = 0 ' idle timer end
        mTimer.Enabled = False
        '=============================
        Debug.Print "IDLE TIMER END"
        '-----------------------------
    End If
End Sub

' get the idle time
Private Function IdleTime() As Long
    Dim lii As LASTINPUTINFO
    lii.cbSize = Len(lii)
    Call GetLastInputInfo(lii)
    IdleTime = FormatNumber((GetTickCount() - lii.dwTime) / 1000, 2)
End Function

' end the timer on exit
Private Sub Class_Terminate()
    Call FinishIdle
End Sub

Bahamas CCTV . Bahamas DVR . Bahamas Camera . Bahamas Video . Bahamas Computer Repair . Bahamas Software . Bahamas Business . Bahamas Real Estate
Copyright (c) 2001/2010 BahamasSecurity.com