Ghi lại thao tác chuột và tái hiện lại thao tác chuột-dự án tự động hóa can thiệp vào các ứng dụng khác trên máy tính

tuhocvba

Administrator
Thành viên BQT
Hiện tại toàn bộ ban quản trị tuhocvba.net đang tập trung phát triển Tool: Ghi lại thao tác chuột và tái hiện lại thao tác chuột
Mục đích: Can thiệp vào các ứng dụng khác trên máy tính một cách tự động.
Nội dung Tool gồm hai phần chính:
Phần 1: Ghi lại toàn bộ thao tác chuột thông qua nút Record: di chuyển chuột, click chuột trái và click chuột phải.
Phần 2: Tool lấy nội dung đã ghi được và tái hiện lại thao tác chuột của User thông qua nút Play.
Video giới thiệu:
Hình ảnh giới thiệu tiến độ công việc hiện nay về cơ bản đã xong 90%.
Bạn cần đăng nhập để thấy hình ảnh
 

Euler

Administrator
Thành viên BQT
Khái quát chương trình:
Thao tác chuột trên máy tính bao gồm: Di chuyển và click sẽ được ghi lại trên Listbox.
Ngoài ra, từ dữ liệu được ghi lại đó, chương trình có thể tái hiện lại thao tác chuột của người dùng.
Ý nghĩa của chương trình:
Đối với các công việc test, việc phải click đi click lại các nút lệnh trên bảng điều khiển diễn ra thường xuyên. Đặc biệt với những người sử dụng Cramas, Dspace,Canalyzer,CANoe,...
Ngoài ra, chương trình cho thể được ứng dụng cho các mục đích khác nhau, tùy thuộc vào ý tưởng của người dùng.
Bạn cần đăng nhập để thấy hình ảnh

Giao diện chương trình:
Bạn cần đăng nhập để thấy hình ảnh

Record: Ghi lại thao tác chuột của người dùng.
Play: Từ dữ liệu thao tác chuột của người dùng mà chương trình đã ghi được, chương trình sẽ tái hiện lại thao tác chuột ấy.
Stop: Dừng chương trình.
Nếu như đang Play để tái hiện lại thao tác chuột của người dùng mà bây giờ ta muốn dừng chương trình thì việc click vào nút Stop sẽ vất vả do chương trình đang hoàn toàn kiểm soát chuột. Vì vậy, có lẽ việc thiết định phím nóng (hot key) để gọi thủ tục Stop là cần thiết. Hiện tại cho tới lúc này chúng tôi vẫn chưa làm điều đó.
Các hàm chính của chương trình: Trái tim của cả chuwong trình là sử dụng các hàm API (hàm trong thư viện của windown) dưới đây:
GetCursorPos:Lấy vị trí của chuột. .
GetAsyncKeyState:Kiểm tra chuột có được Click hay không. .
SetCursorPos:Thiết định vị trí của chuột. .
mouse_event:Bắt chước thao tác chuột. .
 

vbano1

SMod
Thành viên BQT
Về Record:
Sử dụng hai hàm API sau:
GetCursorPos : Lấy tọa độ chuột
GetAsyncKeyState : Kiểm tra chuột được click hay không

Đối với sự kiện di chuyển Move: Đơn vị là ms, tính từ lúc bắt đầu di chuyển. Chương trình ghi lại tọa độ chuột.
Click: Khi sự kiện "Click" diễn ra, sẽ ghi lại tọa độ xảy ra sự kiện này và thời gian khi xảy ra sự kiện.
Khi thực hiện click gồm có hai sự kiện nhỏ, là chuột được ấn Down, và chuột được nhả ra Up.
Tùy thuộc vào loại nút bấm trên chuột được nhấn mà mã sẽ khác nhau, cụ thể: Chuột trái nhấn mã là 1, chuột phải nhấn mã là 2, chuột giữa nhấn mã là 4.
Bạn cần đăng nhập để thấy đính kèm


Bảng chuyển đổi trạng thái:
Bạn cần đăng nhập để thấy đính kèm

・「START」Người dùng click vào nút này trên file excel để hiển thị UserForm.
  Thu nhỏ workbook:Bảnn thân file excel tool này sẽ bị thu nhỏ để không gây phiền hà trong quá trình thao tác chuột.
  Khởi động UserForm: UserForm sẽ được khởi động, cho tới khi nào người dùng click vào biểu tượng X trên Userform thì chương trình sẽ bị đình chỉ hoàn toàn, UserForm sẽ bị đóng và trả về màn hình giao diện Excel thông thường.

・Khởi tạo các thông số cho UserForm: Tên nút bấm, tên của các Label sẽ được cập nhật theo ý đồ thiết kế.

・「Record」: Click vào nút này để tiến hành ghi lại thao tác chuột

・「Stop」: Click vào nút này, nó sẽ đưa UserForm về lại trạng thái ban đầu.

・「Play」: Click vào nút này, nó sẽ dựa trên dữ liệu có trong Listbox và thực thi tái hiện lại thao tác chuột.

・「×Close」: Click vào biểu tượng này trên UserForm, nó sẽ trả lại trạng thái kích cỡ workbook bình thường như khi ta mở file excel ban đầu.
 

giaiphapvba

Administrator
Thành viên BQT
Về Play: Tái hiện lại thao tác người dùng.
Sử dụng hai hàm API dưới đây:
SetCusorPos: Thiết định vị trí của chuột dựa vào tọa độ lưu ở listbox.
mouse_event: Bắt chước thao tác chuột.
Từ dữ liệu Up/Down ghi ở Listbox, hàm này sẽ tái hiện lại thao tác click và nhả chuột.
Những hạn chế của chương trình mong muốn cải thiện: Thao tác giữ chuột và kéo thả chưa thực hiện được. Mong muốn sẽ cải thiện trong tương lai.
Nếu có thể, ghi cả các phím mà người dùng đã sử dụng sau đó tái hiện. Vấn đề khó khăn: Khi người dùng sử dụng tổ hợp nhiều phím, việc tái hiện không đơn giản. Mong muốn trong tương lai sẽ tích hợp cả thao tác bàn phím.

Các đối tượng mà chương trình sử dụng:
Có 4 nút bấm Button được sử dụng: 1 nút khởi động UserForm (START), 1 nút Record để ghi thao tác chuột, 1 nút Play để tái hiện thao tác chuột, 1 nút Stop để dừng chương trình.
Có 1 Label được sử dụng.
Có 1 ListBox được sử dụng.
Tên các đối tượng sử dụng trên UserForm được ghi chú theo như hình dưới đây:
Bạn cần đăng nhập để thấy đính kèm
 

tuhocvba

Administrator
Thành viên BQT
Đầu tiên, code nút bấm để hiển thị UserForm: Về điều này, diễn đàn đã có bài giới thiệu kèm video các bạn xem lại
Mã:
Private Sub CommandButton1_Click()
    Application.WindowState = xlMinimized   'Thu nho man hinh file excel
     
    UserForm1.Show vbModal                  'Hien thi UserForm
 
    ThisWorkbook.Application.WindowState = xlNormal  'Tra lai man hinh Excel
End Sub
UserForm được khởi động, ta code can thiệp vào quá trình này:
Mã:
'////////////////
'
' Load
'
'////////////////
 
Private Sub UserForm_Initialize()   'UserForm_Initialize <= Form_Load
    Dim s1  As String   'Record: Ghi lai thao tac chuot
    Dim s2  As String   'Stop: Dung chuong trinh
    Dim s3  As String   'Play: Tai hien lai thao tac chuot
    
    s1 = UniConvert("Ghi thao tasc chuoojt", "Telex")
    s1 = "Record: " & s1
    
    s2 = UniConvert("Duwfng chuwowng trifnh", "Telex")
    s2 = "Stop: " & s2
    
    s3 = UniConvert("Tasi hieejn laji thao tasc chuoojt", "Telex")
    s3 = "Play:" & s3
    Label1.Caption = s1 & Chr(10) & s2 & Chr(10) & s3
     
    Call DispTop(Application.hWnd, HWND_TOPMOST) 'Hien thi dau tien    'Application.hWnd ← Me.hWnd
 
    KeyList(&H1) = "LeftButton"
    KeyList(&H2) = "RightButton"
    KeyList(&H4) = "MiddleButton"
 
End Sub
Chú ý trong code sử dụng mã Hex, ví dụ &H1 tức là ở hệ cơ số 10 là 1.
Để hiển thị tiếng việt cho Label1, ta đã sử dụng hàm UniConvert. Cái này đã được diễn đàn giới thiệu ở .
 

Euler

Administrator
Thành viên BQT
Code cho UserForm, chú ý khai báo hằng số ở trên đầu phần viết code như sau:
Mã:
Option Explicit
 
Dim MyMode As String
 
Const KEY_CNT = &H10        'So lan quet su kien-Scan event
Const MOVE_INTERVAL = 20    'Thoi gian toi thieu ghi lai trang thai cua chuot
 
Dim KeyList(KEY_CNT) As String      'List cac key tren ban phim
Dim KeyState(KEY_CNT, 2) As Long    'Trang thai cua Key: Truoc do (before):0: Bay gio (now):1 Bien doi:2
Bây giờ ta code cho phần nút bấm Record:
Chú ý: Để xác định là chuột đã di chuyển hay không, ta cần so sánh tọa độ chuột bây giờ và trước đó có bị thay đổi hay không. Tất nhiên chương trình không thể cứ thế mà dò liên tục, đây không phải là tín hiệu tương tự, chương trình thực hiện lấy mẫu trong các khoảng thời gian, do đó tọa độ trước và sau sai lệch nhưng thời gian lấy mẫu phải đảm bảo (tMsg.time - Time_Old) >= MOVE_INTERVAL, khi đó ta coi là chuột đã bị di chuyển. Cần phải có cả yếu tố thời gian và tọa độ, vì trong tình huống chuột đứng yên thì cũng chẳng có ý nghĩa gì phải không nào.
Mã:
'////////////////
'
' Ghi lai thao tac chuot
'
'////////////////
 
Private Sub cmdRecord_Click()    'Ghi lai thao tac chuot
 
    Dim tMsg As Msg         'Tham so truyen thong bao
    
    'Cac ky tu hien thi
    Dim EventName As String 'Ten su kien
    Dim EventTime As String 'Thoi gian tu luc phat sinh su kien lan truoc
    Dim MousePos As String  'Toa do chuot
    Dim UpDown As String    'Up Down
    Dim KeyCode As String   'Ma Key hexa
    Dim KeyStr As String    'Ma key ki tu-string
    
    Dim Time_Old As Long    'Thoi gian phat sinh su kien truoc day
    Dim Pt_Old As POINTAPI  'Toa do chuot truoc day
 
    Dim Rc As Long
 
    SetEnabled False, True, False   'Cho phep/Vo hieu hoa nut nhan
    
    MyMode = "Go"
      
    List1.Clear 'Xoa sach thong tin tren listbox
    
    Call EventsAnlyz(tMsg, True) 'Khoi tao thong so ban dau
    Time_Old = GetTickCount()    'Ghi nho thoi gian
    Pt_Old.x = tMsg.pt.x         'Ghi nho toa do chuot
    Pt_Old.y = tMsg.pt.y
    
    Do
        
        '------------------------------------------------
        Rc = EventsAnlyz(tMsg)   'Bat su kien
        '------------------------------------------------
        UpDown = ""
        KeyCode = ""
        KeyStr = ""
        
        If Rc = 0 Then  'Khong click-chuot di chuyen
 
            'Chuot di chuyen trong thoi gian >= thoi gian toi thieu
            If (tMsg.time - Time_Old) >= MOVE_INTERVAL And _
                Pt_Old.x <> tMsg.pt.x And Pt_Old.y <> tMsg.pt.y Then
                EventName = "Move"
            Else
                EventName = ""
            End If
            
        Else    'Su kien Click dien ra, nhan hoac nha chuot(Down or Up)
            
            EventName = "Click"
            KeyCode = Format(Hex(tMsg.message), "00")            'Nut nhan ma hexa 16
            KeyStr = KeyList(tMsg.message)                       'Ten nut nhan: chuot phai, chuot trai, va chuot giua
            If Rc = -1 Then 'Down
                UpDown = "Down"
            ElseIf Rc = 1 Then 'Up
                UpDown = "Up  "
            End If
        
        End If
        
        If EventName <> "" Then
            EventTime = Format(tMsg.time - Time_Old, "@@@@@")   'Thoi gian, lay 5 chu so sau dau phay
            MousePos = Format(tMsg.pt.x, "@@@@") & "," & Format(tMsg.pt.y, "@@@")   'Toa do chuot lay 4-3 chu so sau dau phay
            With List1
                .AddItem EventTime & vbTab & _
                        MousePos & vbTab & _
                        EventName & vbTab & _
                        UpDown & vbTab & _
                        KeyCode & vbTab & _
                        KeyStr
                .ListIndex = .ListCount - 1 'Select dong cuoi cung
            End With
            
            Time_Old = tMsg.time    'Ghi thoi gian
            Pt_Old.x = tMsg.pt.x    'Ghi toa do chuot
            Pt_Old.y = tMsg.pt.y
        
        End If
 
        DoEvents
        
    Loop While (MyMode = "Go")
    
    SetEnabled True, False, True   'Cho phep/vo hieu hoa nut nhan
 
End Sub
 

giaiphapvba

Administrator
Thành viên BQT
Code cho nút bấm Play trên UserForm:
Chúng ta sẽ có thực thi từng dòng dữ liệu lấy được trên listbox. Sau mỗi lần thực thi chúng ta cho nghỉ (sleep-wait) trong khoảng thời gian lấy ở cột 1 (Cột đầu tiên) trên listbox tương ứng với dòng đó.
Làm việc với chuột, chúng ta biết rằng thời gian nghỉ là rất quan trọng. Cho tới nay, chương trình chưa thể tái hiện được thao tác giữ chuột và kéo thả cũng vì chưa tính toán được thời gian nghỉ phù hợp. Đối với chủ đề đã từng có trên diễn đàn " " chúng ta biết rằng ở chương trình đó, chúng ta đã cho chuột nghỉ 10ms.
Mã:
'////////////////
'
' Play: Tai hien lai thao tac chuot
'
'////////////////
 
Private Sub cmdPlay_Click()    'Play
     
    SetEnabled False, True, False  'Cho phep/Vo hieu hoa nut bam
     
    MyMode = "Play" 'Play
     
    Dim i As Integer
    Dim tmp
    Dim EventTime As String, MousePos As Variant, EventName As String, UpDown As String, KeyCode As String, KeyStr As String
     
    For i = 0 To List1.ListCount - 1
     
        List1.ListIndex = i
     
        tmp = Split(List1.List(i), vbTab)   'Lay du lieu 1 dong, phan tach boi dau Tab
        EventTime = tmp(0)              'Thoi gian
        MousePos = Split(tmp(1), ",")   'Vi tri cua chuot
        EventName = tmp(2)              'Ten su kien
        UpDown = tmp(3)                 'Up/Down
        KeyCode = tmp(4)                'Code(Type click)
        KeyStr = tmp(5)                 'phan loai click
         
        Select Case EventName
            Case "Move"     'Chuot di chuyen
                SetCursorPos Val(MousePos(0)), Val(MousePos(1))
            Case "Click"    'Click
                MouswClick KeyStr, UpDown
            Case Else
        End Select
         
        Sleep Val(EventTime)    'Wait
         
        DoEvents
         
        If MyMode = "" Then Exit For
     
    Next i
   
    MyMode = ""
     
    SetEnabled True, False, True   'Cho phep/Vo hieu hoa nut bam
     
End Sub
 

Euler

Administrator
Thành viên BQT
Code tiếp cho phần Play:
Mã:
Private Sub MouswClick(LeftRight As String, UpDown As String)
    Select Case LeftRight
        Case "LeftButton"
            If UpDown = "Down" Then
                Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
            Else
                Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
            End If
        Case "RightButton"
            If UpDown = "Down" Then
                Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
            Else
                Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
            End If
    End Select
     
End Sub
Code tiếp cho phần Record:
Mã:
Private Function EventsAnlyz(ByRef tMsg As Msg, Optional AllScan As Boolean) As Long
'
' Bat su kien
' Neu tim thay co su thay doi thi dung
'
    Dim pt As POINTAPI  'Toa do cua chuot
    Dim Code As Long    'Ma key hoac nut bam
 
    Dim Rc As Long
     
    For Code = 1 To KEY_CNT
     
        If KeyList(Code) <> "" Then    'Doi tuong scan
            Rc = GetAsyncKeyState(Code)
            If (Rc And &H8001) <> 0 Then
                KeyState(Code, 1) = 1  'Hien tai dang duoc an
            Else
                KeyState(Code, 1) = 0  'Hien tai khong duoc an
            End If
             
            '--------------------
            ' So sanh voi trang thai truoc day
            '--------------------
            KeyState(Code, 2) = KeyState(Code, 0) - KeyState(Code, 1)   'Thay doi
            KeyState(Code, 0) = KeyState(Code, 1) 'Luu lai trang thai hien tai
             
            If KeyState(Code, 2) <> 0 Then
                EventsAnlyz = KeyState(Code, 2)
                tMsg.message = Code
                If AllScan = False Then Exit For  'Dung bat su kien
            End If
        End If
     
    Next Code
     
    Call GetCursorPos(pt)
    tMsg.pt.x = pt.x
    tMsg.pt.y = pt.y
    tMsg.time = GetTickCount()  'Thoi gian

End Function
Code cho phần Stop:
Mã:
'////////////////
'
' STOP
'
'////////////////
 
Private Sub cmdStop_Click()    'Dung
    MyMode = "" 'Dung chuong trinh
    SetEnabled True, False, True   'Cho phep/vo hieu hoa nut bam
End Sub
Code cho biểu tượng X trên UserForm. Khi người dùng muốn close UserForm.
Mã:
'////////////
'
' unload UserForm. Khi nguoi dung click vao bieu tuong X tren UserForm
'
'////////////
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '
    Call DispTop(Application.hWnd, HWND_NOTOPMOST) 'Cho hien thi Excel tro lai binh thuong.
End Sub
Thủ tục con sử dụng trên UserForm:
Mã:
'////////////
'
' Thu tuc con
'
'////////////
 
Private Sub SetEnabled(blRecord As Boolean, blStop As Boolean, blPlay As Boolean)
'
' Thiet dinh Cho phep/Vo hieu hoa nut bam
'
    cmdRecord.Enabled = blRecord
    cmdStop.Enabled = blStop
    cmdPlay.Enabled = blPlay
     
End Sub
 

giaiphapvba

Administrator
Thành viên BQT
Code cho Module:
Đầu tiên chúng ta cùng nhận thức rằng có khác biệt giữa 64bit và 32bit như diễn đàn đã trình bày .
Tóm lại là:
#If Win64 Then
Public Declare PtrSafe Function xxxxxxxxxxxx
#Else
Public Declare Function xxxxxxxxxxxx
#End If
Về module1: Chúng tôi đặt tên là: Module1_Standard
Mã:
Option Explicit
 
 
#If Win64 Then
    ' Hien thi truc Z tren window
    Public Declare PtrSafe Function SetWindowPos Lib "user32" ( _
       ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
       ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
       ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
    ' Hien thi truc Z tren window
    Public Declare Function SetWindowPos Lib "user32" ( _
       ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
       ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
       ByVal cy As Long, ByVal wFlags As Long) As Long
#End If
 
 
'Khai bao hang so
Public Const HWND_TOPMOST = (-1)
Public Const HWND_NOTOPMOST = (-2)
 
 
' Khai bao hang so lien quan toi viec thay doi vi tri kich co cua so window
 
Public Const SWP_NOMOVE = &H2&
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
 
 
'Hien thi len dau tien tren man hinh
Public Function DispTop(hWnd As Long, Sw As Long) As Long
 
    DispTop = SetWindowPos(hWnd, _
                         Sw, _
                         0, _
                         0, _
                         0, _
                         0, _
                         SWP_NOMOVE Or SWP_NOSIZE)
End Function
Tiếp theo là Module2: Chúng tôi đặt tên là : Module2_Record
Mã:
Option Explicit
 
 
'Tiep nhan toa do chuot
Public Type POINTAPI
        X As Long
        Y As Long
End Type
 
'giao dien message
Public Type Msg
    hWnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
 
#If Win64 Then
    'Sau khi khoi dong he thong thoi gian lay mau ms
    Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
     
    'Lay thong tin toa do chuot hien tai
    Public Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
    'Sau khi khoi dong he thong thoi gian lay mau ms
    Public Declare Function GetTickCount Lib "kernel32" () As Long
     
    'Lay thong tin toa do chuot hien tai
    Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If
Tiếp theo là Module thứ 3: Chúng tôi đặt tên là Module3_Replay
Mã:
Option Explicit
 
Public Const MOUSE_MOVED = &H1
Public Const MOUSEEVENTF_ABSOLUTE = &H8000& ' absolute move
 
Public Const MOUSEEVENTF_LEFTUP = &H4       'Nut bam chuot trai duoc nha ra UP
Public Const MOUSEEVENTF_LEFTDOWN = &H2     'Nut bam chuot trai duoc an xuong Down
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20  'Nut bam chuot giua duoc an xuong Down
Public Const MOUSEEVENTF_MIDDLEUP = &H40    'Nut bam chuot giua duoc nha ra UP
Public Const MOUSEEVENTF_RIGHTDOWN = &H8    'Nut bam chuot phai duoc an xuong Down
Public Const MOUSEEVENTF_RIGHTUP = &H10     'Nut bam chuot phai duoc nha ra UP
Public Const MOUSEEVENTF_WHEEL = &H800      'Thao tac giu chuot va keo tha-chua hoat dong tot thi phai
 
 
 
'------------------------------------------------------------------
' Lay trang thai cua Key va chuot
'------------------------------------------------------------------
 
'Khi ham duoc goi se xac dinh xem key hay chuot duoc an khong?
'Hon nua, ke tu khi goi ham GetAsyncKeyState truoc do, Key hay chuot co duoc an hay khong?
'
'Tham so input:
'Gia tri lon nhat cua vKey la 256, vi vay cung se thiet dinh Key gia tuong ung voi no
'
'Gia tri tra ve
'Ham duoc thuc hien thanh cong thi se biet duoc ke tu khi GetAsyncKeyState duoc goi truoc day thi da co key hay chuot duoc an hay khong?
'Neu Key hay chuot duoc an thi se hien thi gia tri tra ve
'Khi bit cao nhat duoc thiet lap
'Se bieu thi hien tai chuot hay key duoc an、
'Khi bit thap nhat duoc thiet lap
'Se bieu thi ke tu khi goi ham GetAsyncKeyState truoc day da tung co key hay chuot duoc an
 
#If Win64 Then
 
    Public Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Long
             
    '------------------------------------------------------------------
    'Bat chuoc thao tac chuot
    '------------------------------------------------------------------
     
    Public Declare PtrSafe 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)
     
     
    'Trong thoi gian chi dinh, khong lam gi
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
     
    'Thiet dinh toa do chuot hien tai
    Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
     
#Else
    '------------------------------------------------------------------
    'Bat chuoc thao tac chuot
    '------------------------------------------------------------------
     
    Public 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)
     
     
    'Trong thoi gian chi dinh, khong lam gi
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
     
    'Thiet dinh toa do chuot hien tai
    Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
#End If
Như vậy về cơ bản từ đầu topic đến giờ, chúng tôi đã cung cấp đầy đủ code để các bạn có thể tự xây dựng Tool.
Toàn bộ code trên, chúng tôi tham khảo .

File Tool demo các bạn có thể download ở đây:
 

tuhocvba

Administrator
Thành viên BQT
Như vậy giai đoạn demo đã hoàn thành. Làm thêm cái video cho đẹp mắt.
Bạn cần đăng nhập để thấy đa phương tiện
Nhắc lại đường link download:
File Tool demo các bạn có thể download ở đây:
 

vbano1

SMod
Thành viên BQT
Như vậy giai đoạn 2 là:
-Ghi lại thao tác bàn phím.
-Tái hiện lại thao tác bàn phím.
Những dự án như thế này nếu có @Snow24 tham gia nữa thì rất thú vị.
 

Euler

Administrator
Thành viên BQT
Vậy nếu có thể, bỏ qua hết thao tác chuột, @Snow24 hãy thử nghiên cứu làm sao load được key (khi người dùng nhấn key) vào listbox xem sao. Sử dụng file này. Sửa lại code trong phần UserForm. Code của Module giữ nguyên và tận dụng. Thử xem trong 5 ngày có làm được không nhé.
 

phamthach

Yêu THVBA nhất
File mình tải về test khi ấn ghi thì bị lỗi như sau:
Bạn cần đăng nhập để thấy hình ảnh

Sau đó treo luôn excel.
Máy mình dùng excel 2013 32 bit
 

vbano1

SMod
Thành viên BQT
File mình tải về test khi ấn ghi thì bị lỗi như sau:
Sau đó treo luôn excel.
Máy mình dùng excel 2013 32 bit
Lỗi của bạn mình hiểu nguyên nhân rồi. Tối mình upload lại file và nhờ bạn test lại sau nhé. Cám ơn bạn.
 

Euler

Administrator
Thành viên BQT
@phamthach ơi, bạn download và test trên máy tính kia giúp chúng mình nhé.
File download:
Nguyên nhân lỗi trên máy 32 bit là do chúng minh chưa khai báo thư viện hàm cho 32 bit.
Báo lại kết quả giúp chúng mình nhé.
Bạn cần đăng nhập để thấy hình ảnh
 

phamthach

Yêu THVBA nhất
@phamthach ơi, bạn download và test trên máy tính kia giúp chúng mình nhé.
File download:
Nguyên nhân lỗi trên máy 32 bit là do chúng minh chưa khai báo thư viện hàm cho 32 bit.
Báo lại kết quả giúp chúng mình nhé.
Bạn cần đăng nhập để thấy hình ảnh
Đã test và ok rồi ạ. Tuy nhiên mình thấy có 2 phát giật khoảng 1s. không biết là do máy mình hay gì nữa. @@~
 

vbano1

SMod
Thành viên BQT
Đã test và ok rồi ạ. Tuy nhiên mình thấy có 2 phát giật khoảng 1s. không biết là do máy mình hay gì nữa. @@~
Không sao đâu. Bắt chước thao tác chuột thôi, không bắt chước được y hệt đâu. Tốc độ di chuột của máy sẽ nhanh hơn người.
Nó chỉ bắt chước như thế này thôi: Di chuột hoặc click ở vị trí ấy. rồi sau đó nghỉ (sleep) đợi thao tác tiếp theo.
Thực tế nếu là tay con người, thì họ cần mất khoảng thời gian di chuyển tới tọa độ x,y trong khoảng thời gian t (ms).
Còn máy thì gần như tức thời, nó ở vị trí x,y và thao tác, rồi nghỉ t(ms) không làm gì. Hơi khác nhau đúng không.

Thao tác của con người càng thong thả thì càng dễ bắt chước. Tức là đừng thao tác nhanh quá.
Cảm ơn @phamthach đã phản hồi giúp diễn đàn vá lỗi.
 
Giai đoạn 2: Ghi lại thao tác bàn phím và tái hiện lại thao tác bàn phím
Giai đoạn 2.1: Ghi lại thao tác bàn phím.

File demo:
Hình ảnh demo:
Bạn cần đăng nhập để thấy hình ảnh
 

Euler

Administrator
Thành viên BQT
Bạn cần đăng nhập để thấy hình ảnh


Nguyên liệu xây dựng UserForm:
Lable : 1
CommanButton : 2
Listbox : 1

Bình luận: Máy tính của mọi người hoạt động đều tốt, trừ máy tính laptop HP của admin tuhocvba thì không tốt.
Các bạn thử máy tính của các bạn xem sao nhé.
Chú ý một phím được ấn thì trên Listbox phải hiển thị hai trạng thái Up/Down của phím đó. Nếu thiếu Down hoặc Up là không ổn.
 

vbano1

SMod
Thành viên BQT
Giai đoạn 2: Ghi lại thao tác bàn phím và tái hiện lại thao tác bàn phím
Giai đoạn 2.2: Tái hiện lại thao tác bàn phím bằng nút bấm Play

File demo:
Hình ảnh demo:
Bạn cần đăng nhập để thấy hình ảnh
 
Top