TraceMouse

Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type mouseState
Key As Integer
State As Boolean
End Type

'Mouse Movement

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

'Mouse Click

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetMessageExtraInfo Lib "user32" () As Long

Dim mousePath() As POINTAPI
Dim mouseState() As mouseState

Dim Status As String
Private Const is_Rec As String = "Done Recording"

Private Sub SetProps(ByVal State As String)
tPath.Enabled = True
Status = State
Me.Hide
End Sub

Private Sub Form_Unload(Cancel As Integer)
Erase mousePath
Erase mouseState
End Sub

Private Sub Play_Click()
SetProps "Playing"
End Sub

Private Sub Record_Click()
If txtTime.Text = "" Then
MsgBox "Unable to record mouse movements, Tracking seconds textbox is empty", vbCritical, "Unable to process"
Else
ReDim mousePath(Val(txtTime.Text) * 20)
ReDim mouseState(Val(txtTime.Text) * 20)
SetProps "Recording"
End If
End Sub

Private Sub tPath_Timer()
Static timer As Integer

timer = timer + 1
If timer > UBound(mousePath) Then
tPath.Enabled = False
Me.Caption = "Done " & Status
timer = 0
Me.Show
Exit Sub
End If

If Left(Status, 1) = "R" Then
Dim Cnt As Integer, retval As Integer
GetCursorPos mousePath(timer)
retval = GetAsyncKeyState(1)
retval = GetAsyncKeyState(1)
mouseState(timer).State = (retval = -32768) 'If leftbutton is pressed
Else
SetCursorPos mousePath(timer).x, mousePath(timer).y
With mousePath(timer)
If mouseState(timer).State = True Then
DoMouse .x, .y, MOUSEEVENTF_LEFTDOWN
ElseIf mouseState(timer).State = False And mouseState(timer - 1).State = True Then
DoMouse .x, .y, MOUSEEVENTF_LEFTUP
Else
DoMouse .x, .y
End If
End With
End If
End Sub

Private Sub DoMouse(ByVal x As Long, ByVal y As Long, Optional flag As Long)
mouse_event flag, 0&, 0&, 0&, 0&
End Sub
Registrare e riprodurre gli spostamenti del Mouse