Mouse Movement Playback & Record

Hi , I have a code shown below which records mouse movement and records the movement and saves it into a file so that it can be opened and 'playback' .However , my problem is that it cannot work in NT . I think it may be due to the Record Line that was failing a HookID return . Works fine on Win98 .This line is the problem:
lHookID = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, 0&, 0&)

Can you help me in this ? I need it to work in NT & I am using VB 6 for this api programming.

' in module
-----------------------------------------------
' Option Explicit

Public Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
Public i
Public Type POINTAPI
x As Long
y As Long
End Type

Public Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

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 UnhookWindowsHookEx Lib "user32" (ByVal hHook 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 SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const WH_JOURNALRECORD = 0
Public Const WH_JOURNALPLAYBACK = 1

Public Const HC_GETNEXT = 1
Public Const HC_SKIP = 2

Public Const WH_GETMESSAGE = 3
Public Const WH_CALLWNDPROC = 4

Public Const WM_CANCELJOURNAL = &H4B
Public Const WM_MOUSEMOVE = &H200

Public lHookID As Long
Public lAppHookID As Long

Public tEventList() As EVENTMSG
Public tEVENTMSG As EVENTMSG
Public lMsgCount As Long
Public lMsgCountMax As Long

Public Sub RecordMouse()
'Record the Mouse Events
If lHookID <> 0 Then Exit Sub
lMsgCountMax = 0
lMsgCount = 0
ReDim tEventList(0)
'Set an application hook to monitor for messages sent to this app
lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)

'Set the Journal Hook to allow us to record all Mouse Movements
lHookID = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, 0&, 0&)

Debug.Print "Recording..."
End Sub

Public Sub RecordMouseStop()
'Stop Recording the Mouse Events
If lHookID <> 0 Or lAppHookID <> 0 Then
Call UnhookWindowsHookEx(lAppHookID)
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
lAppHookID = 0
Debug.Print "Recording Stopped - " & lMsgCountMax & " messages recorded."
End If
End Sub

Public Sub PlayBackMouse()
'Playback the Journal Recorded with JournalRecord
If lHookID <> 0 Then Exit Sub
lMsgCount = 1
tEVENTMSG = tEventList(1)
'Set an application hook to monitor for messages sent to this app
lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
lHookID = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf JournalPlaybackProc, 0&, 0&)
Debug.Print "Playing..."
End Sub

Public Sub PlayBackMouseStop()
'Stop Journal Playback
If lHookID <> 0 Or lAppHookID <> 0 Then
Call UnhookWindowsHookEx(lAppHookID)
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
lAppHookID = 0
Debug.Print "Playback Stopped."
End If
End Sub

Public Function GetMessageProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tMSG As MSG

If Code < 0 Then
'Pass the message along...
GetMessageProc = CallNextHookEx(lAppHookID, Code, wParam, ByVal lParam)
Else
'Grab the MSG structure
CopyMemory tMSG, ByVal lParam, Len(tMSG)
Select Case tMSG.message

Case WM_CANCELJOURNAL
'An external process has requested us to stop this operation
Call UnhookWindowsHookEx(lHookID)
lHookID = 0

End Select
End If
End Function

Public Function JournalRecordProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo LogError
If Code < 0 Then

'Pass this message along...
JournalRecordProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)

Else

'Grab the Event Message Structure
CopyMemory tEVENTMSG, ByVal lParam, Len(tEVENTMSG)

'Only record MOUSE_MOVE events
If tEVENTMSG.message = WM_MOUSEMOVE Then
lMsgCountMax = lMsgCountMax + 1
ReDim Preserve tEventList(lMsgCountMax)
tEventList(lMsgCountMax) = tEVENTMSG
End If
JournalRecordProc = 0

End If

Exit Function

LogError:
Debug.Print "Error in JournalRecordProc()"
End Function

Public Function JournalPlaybackProc(ByVal Code As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
Dim iX As Integer, iY As Integer, lTime As Long
On Error GoTo LogError

Select Case Code

Case HC_SKIP

'Select the Next Event Message
lMsgCount = lMsgCount + 1
If lMsgCount >= lMsgCountMax Then
'Last Message processed, so remove the Journal Hook
PlayBackMouseStop
Else
tEVENTMSG = tEventList(lMsgCount)
End If
JournalPlaybackProc = 0

Case HC_GETNEXT

'Grab the Event Message Structure and Process the Message
lParam = VarPtr(tEVENTMSG)
With tEVENTMSG
If .message = WM_MOUSEMOVE Then
iX = .paramL
iY = .paramH
'Pause time for processing lag (calculated as time between this and prev. message)
lTime = (.time - tEventList(lMsgCount - 1).time) - 7
'Pause can't be less than 0
If lTime < 0 Then lTime = 0
'Move the Cursor accordingly
SetCursorPos iX, iY
'If this isn't the 1st message pause before processing the next message
If lMsgCount > 1 Then
Sleep lTime
End If
End If
End With

Case Else

'Pass this message along...
JournalPlaybackProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
Exit Function

End Select

Exit Function

LogError:
Debug.Print "Error in JournalPlaybackProc():" & Err.Description, lMsgCount, lMsgCountMax
End Function

Public Sub SaveEvents(ByVal sFilename As String, ByRef tEventArray() As EVENTMSG)
Dim iFile As Integer
Dim lIndex As Long

If Len(Dir(sFilename)) Then Kill sFilename
iFile = FreeFile
Open sFilename For Random Access Write As iFile
For lIndex = LBound(tEventArray) To UBound(tEventArray)
Put #iFile, , tEventArray(lIndex)
Next
Close iFile
End Sub

Public Sub LoadEvents(ByVal sFilename As String, ByRef tEventArray() As EVENTMSG)
Dim iFile As Integer
Dim lIndex As Long

If Len(Dir(sFilename)) = 0 Then Exit Sub
iFile = FreeFile
Open sFilename For Random Access Read As iFile
While Not EOF(iFile)
ReDim Preserve tEventArray(lIndex)
Get #iFile, , tEventArray(lIndex)
lIndex = lIndex + 1
Wend
Close iFile
End Sub

Public Sub SaveTheEvents()
Call SaveEvents("C:Events.dat", tEventList)
End Sub

Public Sub LoadTheEvents()
Call LoadEvents("C:Events.dat", tEventList)
lMsgCountMax = UBound(tEventList)
End Sub
' in form
-----------------------------------------------
Private Sub Form_Initialize()
Dim MOUSEPOS As String
Dim i As Long
i = 0
ChDir "C:"
End Sub

Private Sub Load_Click()
'LoadTheEvents


MOUSEPOS = CStr(i) + " Events.dat"
Call SaveEvents(MOUSEPOS, tEventList)
Call LoadEvents(MOUSEPOS, tEventList)
PlayBackMouse
'" + CStr(i) + "
'+ CStr(i) + Events.dat"
End Sub

Private Sub Play_Click()
PlayBackMouse
End Sub

Private Sub Record_Click()
RecordMouse
End Sub

Private Sub Save_Click()
'SaveTheEvents
Call SaveEvents("C:Events.dat", tEventList)
End Sub

Private Sub Stop_Click()
RecordMouseStop
i = i + 1
End Sub






Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories