detecting mouse or keyboard action

[ale1981]

Hi guyz,

I am after some code that can detect the movement of the mouse and keyboard like a screensaver. What I am trying to do is automatically log off somebody from Windows when they have not touched the computer for a certain amount of time. I know the code to log off, restart, shutdown etc just need the detection code.

Thanks in advance

ale.

[graffsoft]

I really need to know this. Please can anyone help?

[ale1981]

anybody know the answer to this

[graffsoft]

Form Code

Dim m_lngKeyboad As Long
Dim m_mouseMove As Long
Private Sub Form_Load()
m_lngKeyboad = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, 0)
m_mouseMove = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, 0)
tmid = Now()
End Sub

Private Sub Form_Unload(Cancel As Integer)
If m_lngKeyboad <> 0 Then
UnhookWindowsHookEx m_lngKeyboad
UnhookWindowsHookEx m_mouseMove
End If
End Sub

Private Sub Timer1_Timer()
If DateDiff("n", tmid, Now()) > 1 Then
Shell "notepad.exe", vbNormalFocus
UnhookWindowsHookEx m_lngKeyboad
UnhookWindowsHookEx m_mouseMove
End
End If

End Sub


Module Code
Option Explicit

Public Type POINTAPI
x As Long
y As Long
End Type
Public Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As Long
wHitTestCode As Long
dwExtraInfo As Long
End Type



Public Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const HC_ACTION = 0

Private Const WH_KEYBOARD = 2
Public Const WH_MOUSE = 7
Public Const WM_MOUSEMOVE = &H200
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101

Public Const LLKHF_ALTDOWN = &H20

Public tmid As Date

Dim m_udtKEYBOARDHOOK As KBDLLHOOKSTRUCT
Dim m_udtMOUSEHOOK As MOUSEHOOKSTRUCT
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If (nCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Or wParam = WM_KEYUP Then
'CopyMemory m_udtKEYBOARDHOOK, ByVal lParam, Len(m_udtKEYBOARDHOOK)
'change this to call your actual EXE, otherwise it will crash
tmid = Now()
End If
End If

KeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function

Public Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEMOVE Then
'CopyMemory m_udtMOUSEHOOK, ByVal lParam, Len(MOUSEHOOKSTRUCT)
'change this to call your actual EXE, otherwise it will crash
tmid = Now()
End If
End If

MouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function

[graffsoft]

seeing as I am a programing guru,
check out my website:

www27.brinkster.com/mdtwo

[rhand]

I use this and it works great


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim CurPos As POINTAPI
Dim OldX As Single
Dim OldY As Single
Dim StartTime As Date

Function Start()
StartTime = Format(Time, "hh:mm:ss")
End Function

Private Sub Form_Load()

Start
Timer1.Interval = 1

End Sub


Private Sub Timer1_Timer()

For I = 32 To 127
If GetAsyncKeyState(I) Then Start
If GetAsyncKeyState(vbLeftButton) Then Start
If GetAsyncKeyState(vbRightButton) Then Start

Next

MyPos = GetCursorPos(CurPos)


X = CurPos.X
Y = CurPos.Y
If OldX = X And OldY = Y Then
'The mouse is still
Else
'the Mouse is not still
OldX = X
OldY = Y

Start

End If


retval = StartTime - Time
retval = Format(retval, "hh:mm:ss")
If retval = "00:00:10" Then
MsgBox "I work"
End If



End Sub

[ale1981]

Thanks rhand and graffsoft, since rhands version was quite a bit shorter i used that one and it works perfectly, thanks again guyz.