Re: Mouse Movement Playback
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
>
>
>
>
Re: Mouse Movement Playback
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
>
>
>
>
Re: Mouse Movement Playback
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
>>
>>
>>
>>
>
>
Re: Mouse Movement Playback
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
>>
>>
>>
>>
>
>
