Mouse Movement Playback

[Eugene]

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

[Dean Earley]

Where is it failing?

--
Dean Earley (dean.earley@icode.co.uk)
Assistant Developer

iCode Systems
"Eugene" <eng70640@nus.edu.sg> wrote in message
news:3a3f891f$1@news.devx.com...
>
> 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
>
>
>
>

[Dean Earley]

Where is it failing?

--
Dean Earley (dean.earley@icode.co.uk)
Assistant Developer

iCode Systems
"Eugene" <eng70640@nus.edu.sg> wrote in message
news:3a3f891f$1@news.devx.com...
>
> 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
>
>
>
>

[Eugene]

The failure is the load events code whereby I cannot when i try to load the
file it does not 'playback' the mouse movement.
"Dean Earley" <dean.earley@icode.co.uk> wrote:
>Where is it failing?
>
>--
>Dean Earley (dean.earley@icode.co.uk)
>Assistant Developer
>
>iCode Systems
>"Eugene" <eng70640@nus.edu.sg> wrote in message
>news:3a3f891f$1@news.devx.com...
>>
>> 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
>>
>>
>>
>>
>
>

[Eugene]

The failure is the load events code whereby I cannot when i try to load the
file it does not 'playback' the mouse movement.
"Dean Earley" <dean.earley@icode.co.uk> wrote:
>Where is it failing?
>
>--
>Dean Earley (dean.earley@icode.co.uk)
>Assistant Developer
>
>iCode Systems
>"Eugene" <eng70640@nus.edu.sg> wrote in message
>news:3a3f891f$1@news.devx.com...
>>
>> 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
>>
>>
>>
>>
>
>