Hi , I have been trying to do a project which record mouse movement and then
record the mouse movement
into a file so that it can be loaded to 'playback' mouse movement . I have
succeed in recording & playing
back the mouse movement and saving into a file but NOT able to load the file
so that it can 'playback'
the mouse movement . The code is shown below. Can anyone look at my code
and help me ?
' Option Explicit

Private Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type

Private Type POINTAPI
x As Long
y As Long
End Type

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

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

Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As
Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long,
ByVal nCode As Long, ByVal
wParam As Long, lParam As Any) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal
y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const WH_JOURNALRECORD = 0
Private Const WH_JOURNALPLAYBACK = 1

Private Const HC_GETNEXT = 1
Private Const HC_SKIP = 2

Private Const WH_GETMESSAGE = 3
Private Const WH_CALLWNDPROC = 4

Private Const WM_CANCELJOURNAL = &H4B
Private Const WM_MOUSEMOVE = &H200

Private lHookID As Long
Private lAppHookID As Long

Private tEventList() As EVENTMSG
Private tEVENTMSG As EVENTMSG
Private lMsgCount As Long
Private 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

Private 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

Private 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

Private 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 the Form
------------------------------------------------
Private Sub Load_Click()
LoadTheEvents
End Sub

Private Sub Play_Click()
PlayBackMouse
End Sub

Private Sub Record_Click()
RecordMouse
End Sub

Private Sub Save_Click()
SaveTheEvents
End Sub

Private Sub Stop_Click()
RecordMouseStop
End Sub