Cách HOOK chuột và bàn phím toàn hệ thống trong VB6 đây !!!

[truongphu]

Tên bài viết: Cách HOOK chuột và bàn phím toàn hệ thống trong VB6 đây !!!
Tác giả: gửi bởi T7 vào ngày Chủ nhật 02/09/2007 8:20 pm
Cấp độ bài viết: Chưa đánh giá
Tóm tắt: Copy từ Diễn đàn cũ

---

Lúc trước em cũng đã nghĩ là hook trong vb6 thì không thể được, vd như khi ta tạo một hook bàn phím xác định phím nhấn thì nó chỉ xác định được trong form mà thôi, hay xác định chuột đang click cũng chỉ xác định được khi click trong form. Vậy nên, ta phải sử dụng một thư viện hổ trợ hook viết bằng ngôn ngữ C hoặc C++, hay làm theo kiểu bỏ hàm xác định phím nhấn vào một timer - cách này làm chương trình tốn nhiều tài nguyên hơn , may thay em đã tìm được cách hook trong VB6, thật ra nó rất đơn giản:

Ví dụ 1: Xác định phím được nhấn
Trong project của mình, tạo một module và thêm đoạn code này vào:

Code: Select all

Option ExplicitPublic hKbdHook As LongPrivate Const WH_KEYBOARD_LL As Integer = 13Private Const HC_ACTION As Integer = 0Private Const WM_KEYDOWN As Long = &H100Private Const WM_KEYUP As Long = &H101  Private Type KBDLLHOOKSTRUCT    vkCode As Integer    scanCode As Integer    flags As Integer    time As Integer    dwExtraInfo As Integer    End Type  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  Public 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, ByVal lParam As Long) As Long  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)  Private Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Integer     Dim kbdllhs As KBDLLHOOKSTRUCT    CopyMemory kbdllhs, ByVal lParam, Len(kbdllhs)      If nCode = HC_ACTION Then        LowLevelKeyboardProc = CallNextHookEx(hKbdHook, nCode, wParam, lParam)          Select Case wParam            Case WM_KEYDOWN                frmMain.Caption = kbdllhs.vkCode & " --- " & Chr(kbdllhs.vkCode)            Case WM_KEYUP        End Select Else: LowLevelKeyboardProc = CallNextHookEx(hKbdHook, nCode, wParam, lParam)End If End Function  Sub Main()    hKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)    If hKbdHook = 0 Then        MsgBox "Initialisation of keyboard hook failed.", vbCritical, "Keyboard Hook"        Exit Sub    End If    frmMain.ShowEnd Sub

Tiếp theo, tạo một form tên "frmMain" và thêm đoạn code bên dưới đây vào

Code: Select all

Option Explicit Private Sub Form_Unload(Cancel As Integer)    Call UnhookWindowsHookEx(hKbdHook)End Sub

Cuối cùng, vào "Project" => <Tên Project> + "Propeties...". Chọn Startup Object là "Sub Main",... Xong, bây giờ chạy project vừa tạo rồi vào bất cứ đâu, gõ bất cứ phím gì, sau đó xem lại caption của form frmMain nhé

Tiếp theo...

Ví dụ 2: Tạo phím tắt cho chương trình
Nếu đã nắm rõ cách thức hoạt động của ct được tạo ra ở ví dụ 1 trên đây thì ở ví dụ này bạn sẽ không khó khăn để biết cách thức hoạt động của nó bởi đoạn mã cũng gần như ví dụ trên

Trong project, tạo một module và thêm đoạn code này vào:

Code: Select all

Option ExplicitPublic hKbdHook As LongPrivate Const WH_KEYBOARD_LL As Integer = 13Private Const HC_ACTION As Integer = 0Private Const WM_KEYDOWN As Long = &H100Private Const WM_KEYUP As Long = &H101  Private Type KBDLLHOOKSTRUCT    vkCode As Integer    scanCode As Integer    flags As Integer    time As Integer    dwExtraInfo As IntegerEnd Type Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer  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  Public 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, ByVal lParam As Long) As Long  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)  Private Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Integer     Dim kbdllhs As KBDLLHOOKSTRUCT    CopyMemory kbdllhs, ByVal lParam, Len(kbdllhs)      If nCode = HC_ACTION Then        LowLevelKeyboardProc = CallNextHookEx(hKbdHook, nCode, wParam, lParam)          Select Case wParam            Case WM_KEYDOWN                 If (GetKeyState(vbKeyControl) And &HF0000000) And kbdllhs.vkCode = Asc("Q") Then Unload frmMain            Case WM_KEYUP        End Select Else: LowLevelKeyboardProc = CallNextHookEx(hKbdHook, nCode, wParam, lParam)End If End Function  Sub Main()    hKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)    If hKbdHook = 0 Then        MsgBox "Initialisation of keyboard hook failed.", vbCritical, "Keyboard Hook"        Exit Sub    End If    frmMain.ShowEnd Sub

Tiếp theo, tạo một form tên "frmMain" và thêm đoạn code bên dưới đây vào

Code: Select all

Option Explicit             Private Sub Form_Unload(Cancel As Integer)          Call UnhookWindowsHookEx(hKbdHook)      End Sub

Cuối cùng, như ví dụ 1: vào "Project" => <Tên Project> + "Propeties...". Chọn Startup Object là "Sub Main",... Ok, bây giờ hãy chạy ct vừa tạo, vào bất cứ đâu và nhấn Ctrl + Q, lập tức, chương trình sẽ đóng ngay

Đây là một cách giúp khóa bàn phím lại bằng hook (không làm gì được luôn , ngoại trừ cách gọi Task Manager ) và cũng có thể gọi đây là một cách "phá máy"

Giống như trên, đầu tiên ta tạo một module và thêm đoạn code dưới vào

Code: Select all

Option ExplicitPublic hKbdHook As LongPrivate Const WH_KEYBOARD_LL As Integer = 13Private Const HC_ACTION As Integer = 0Private Const WM_KEYDOWN As Long = &H100Private Const WM_KEYUP As Long = &H101  Private Type KBDLLHOOKSTRUCT    vkCode As Integer    scanCode As Integer    flags As Integer    time As Integer    dwExtraInfo As Integer    End Type  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  Public 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, ByVal lParam As Long) As Long  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)  Private Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Integer     Dim kbdllhs As KBDLLHOOKSTRUCT    CopyMemory kbdllhs, ByVal lParam, Len(kbdllhs)      If nCode = HC_ACTION Then        LowLevelKeyboardProc = CallNextHookEx(hKbdHook, nCode, wParam, lParam)          Select Case wParam            Case WM_KEYDOWN                LowLevelKeyboardProc = -1            Case WM_KEYUP        End Select Else: LowLevelKeyboardProc = CallNextHookEx(hKbdHook, nCode, wParam, lParam)End If End Function  Sub Main()    hKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)    If hKbdHook = 0 Then        MsgBox "Initialisation of keyboard hook failed.", vbCritical, "Keyboard Hook"        Exit Sub    End If    frmMain.ShowEnd Sub

Ok, giờ tạo một form tên frmMain và thêm đoạn code này vào

Code: Select all

Option Explicit Private Sub Form_Unload(Cancel As Integer)    Call UnhookWindowsHookEx(hKbdHook)End Sub

Rồi, như thường lệ , vào "Project" => <Tên Project> + "Propeties...". Chọn Startup Object là "Sub Main",... Xong, he he, bây giờ thử nhấn bất cứ phím gì đi , đảm bảo nhấn banh bàn phím luôn cũng không có gì xảy ra với máy đâu (miễn đừng gọi Task Manager là được
Lưu ý: Khi hook để khóa bàn phím thì nên cẩn thận, thoát đúng quy cách (thoát bằng cách click vô nút đóng bên phải trên cửa sổ để nó đóng câu lện hook lại, nếu không thì... Bàn phím sẽ bị khóa lại cho tới khi bạn tắt ct trong task manager (còn nếu đang chạy thử trong VB6 thì không sao, thoát ra khỏi VB6 là được)
Em xin tiếp tục giới thiệu với mọi người cách hook tiếp theo, cách hook chuột !!!
Đầu tiên ta tạo một Project, tạo một module và thêm đoạn code dưới vào

Code: Select all

Public hHook As Long Public 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 Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Public Const WM_RBUTTONDBLCLK = &H206Public Const WM_RBUTTONDOWN = &H204Public Const WM_RBUTTONUP = &H205Public Const WM_MOUSEMOVE = &H200Public Const WM_LBUTTONDBLCLK = &H203Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Private Const HC_ACTION As Integer = 0 Public Type POINTAPI    X As Long    Y As LongEnd TypePublic Type EVENTMSG        message As Long        paramL As Long        paramH As Long        Time As Long        hwnd As LongEnd TypePublic Type MEvent    X As Long    Y As Long    Time As Long    Click As LongEnd Type   Sub Main()    frmMain.Show    hHook = SetWindowsHookEx(WH_MOUSE, AddressOf HookProc, App.hInstance, 0&)    If hHook = 0 Then        MsgBox "Error !!!", vbCritical    End IfEnd Sub Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long     If nCode = HC_ACTION Then        Dim hookMsg As EVENTMSG        HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)        Call CopyMemory(hookMsg, ByVal lParam, Len(hookMsg))        Select Case hookMsg.message            Case WM_MOUSEMOVE                frmMain.Caption = hookMsg.paramL & ":" & hookMsg.paramH            Case WM_LBUTTONDOWN                frmMain.Caption = "LEFT BUTTON DOWN"            Case WM_RBUTTONDOWN                frmMain.Caption = "RIGHT BUTTON DOWN"            Case WM_LBUTTONUP                frmMain.Caption = "LEFT BUTTON UP"            Case WM_RBUTTONUP                frmMain.Caption = "RIGHT BUTTON UP"        End Select    Else: HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)    End IfEnd Function

Xong, sửa cái tên của form1 lại thành frmMain và tiếp tục thêm đoạn code này vô

Code: Select all

Private Sub Form_Unload(Cancel As Integer)    If hHook <> 0 Then Call UnhookWindowsHookEx(hHook)End Sub

Rồi, như thường lệ , vào "Project" => <Tên Project> + "Propeties...". Chọn Startup Object là "Sub Main" => Xong rùi, cứ chạy thử chương trình đi, di chuyển chuột và click vài cái để xem sự thây đổi trên tiêu đề của form frmMain nhé

[truongphu]

Thủ thuật: Có thể Hook đồng thời Mouse và Keystore hay không?
Tác giả: sendmessage
Mô tả: Có thể Hook đồng thời Mouse và Keystore hay không?

---

In Module

Code: Select all

'* The SetWindowsHookEx function installs an application-defined hook procedure into a hook chain. You would install a hook procedure to monitor the system for certain types of events. These events are associated either with a specific thread or with all threads in the system.Public 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'* The UnhookWindowsHookEx function removes a hook procedure installed in a hook chain by the SetWindowsHookEx function.Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long'* The CallNextHookEx function passes the hook information to the next hook procedure in the current hook chain. A hook procedure can call this function either before or after processing the hook information.Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long'* The CopyMemory function copies a block of memory from one location to another.Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) '* Type to hold the mouse coordinatesPrivate Type POINTAPI    X As Long    Y As LongEnd Type '******************************************************'* System messages for Mouse that we want to tracePrivate Const WM_MOUSEMOVE           As Long = &H200Private Const WM_MOUSEWHEEL          As Long = &H20APrivate Const WM_LBUTTONDOWN         As Long = &H201Private Const WM_LBUTTONUP           As Long = &H202Private Const WM_RBUTTONDOWN         As Long = &H204Private Const WM_RBUTTONUP           As Long = &H205Private Const WM_MBUTTONDOWN         As Long = &H207Private Const WM_MBUTTONUP           As Long = &H208'****************************************************** '******************************************************'* System messages foe Keyboard that we want to tracePrivate Const WM_KEYDOWN As Long = &H100Private Const WM_KEYUP As Long = &H101'****************************************************** '* System hook for mouse that we'll usePublic Const WH_MOUSE_LL           As Long = 14Global lKeyboardHook               As Long'* System hook for Keyboard that we'll usePublic Const WH_KEYBOARD_LL        As Long = 13Global lMouseHook                  As Long  Public Const HC_ACTION = 0 '* Type to hold Mouse Hook informationPrivate Type MOUSELLHOOKSTRUCT    point As POINTAPI    data As Long    flags As Long    time As Long    extra As LongEnd Type '* Type to hold Keyboard Hook informationPrivate Type KBDLLHOOKSTRUCT    vkCode As Integer    scanCode As Integer    flags As Integer    time As Integer    dwExtraInfo As IntegerEnd Type Private mousedata As MOUSELLHOOKSTRUCTPrivate keyboarddata As KBDLLHOOKSTRUCT Public Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long    If (nCode = HC_ACTION) Then        ' Mouse data not used in this example, but useful        CopyMemory mousedata, ByVal lParam, Len(mousedata)        Select Case wParam            Case WM_MOUSEMOVE                Form1.Cls                Form1.Print "Mouse(" & mousedata.point.X & "," & mousedata.point.Y & ")"            Case WM_MOUSEWHEEL                Form1.Cls                Form1.Print "Wheel(" & mousedata.point.X & "," & mousedata.point.Y & ")"            Case WM_LBUTTONDOWN                            Case WM_LBUTTONUP                            Case WM_RBUTTONDOWN                            Case WM_RBUTTONUP                           Case WM_MBUTTONDOWN                            Case WM_MBUTTONUP                            Case Else                ' not implemented yet        End Select    End If    MouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)End Function Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Integer    If nCode = HC_ACTION Then        CopyMemory keyboarddata, ByVal lParam, Len(keyboarddata)        Select Case wParam            Case WM_KEYDOWN                Form1.Cls                Form1.Print "KeyDown: " & keyboarddata.vkCode                            Case WM_KEYUP                Form1.Cls                Form1.Print "KeyUp: " & keyboarddata.vkCode                    End Select    End If    KeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)End Function 

In Form1

Code: Select all

Private Sub Form_Load()    lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0)    lKeyboardHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardProc, App.hInstance, 0)End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)    UnhookWindowsHookEx lMouseHook    UnhookWindowsHookEx lKeyboardHookEnd Sub

[nhokstart]

mục này k thấy ai nói j đến hết chắt là k biết j hết. em cũng vậy nhưng rất cảm ơn pac đã giúp em hiểu thêm 1 ít.

[haluwen9]

tuy đọc nhìu khó hiểu, nhưng từ từ mò mẫm, kiếm thêm tài liệu thì sẽ giỏi hơn được nhỉ
Thanks

[01632911829]

Hay! Làm và coi code là hiểu.

[lsqk]

Cảm ơn bác rất nhiều, em cần nghiên cứu cái này để viết bộ gõ chữ Hán.

[Hong Hai]

Xin chào các anh chị em. Nhờ code của bác truongphu mình viết được bộ gõ cho mình rồi. Nhưng hiện tại mình phải dùng clipboard để đưa những chữ của mình vào ứng dụng. Các bạn có cách nào không dùng clipboard được không, giống như Unikey vậy đó. Xin cám ơn các bạn.
Bình thường, mình muốn gọi 1 ký tự không có trên bàn phím, thì nhấn nút Alt + mã Unicode của nó.
VD:chữ "á": Alt+0225 (phím số bên keypad)
Mình dùng keybd_event để gởi tổ hợp phím đó:
- Trong MS word thì OK
- Trong wordPad thì cũng được nhưng có tiếng "Beep" kèm theo
- Trong Corel thì 1 loạt tiếng "Beep" nhưng không chữ nào vào.
- Trong Illustracter thì nó bay vào luôn số 0225
Mong các bạn góp ý giúp. Xin cám ơn các bạn.

[Hong Hai]

Các bạn giúp mình đi, chỉ hướng cho mình suy nghĩ cũng được, hay cho mình xin tài liệu có liên quan cũng được. Xin cám ơn!

[phanthequang4101987]

bạn vào mục "mã nguồn"/tiện ích tải bộ gõ VBkey của bác thanhtuyen về mà xem có nguyên cả bộ gõ như unikey (mình đã test trên win7 và win8 32 bít chạy ngon)
viewtopic.php?f=33&t=13876

[Hong Hai]

Cám ơn bạn (phanthequang4101987) đã quan tâm, mình có xem qua chương trình này rồi. Và cũng nhờ những bài viết hướng dẫn và phân tích của bạn ấy mà mình biết chút chút.
Vấn đề của mình là làm sao gởi tổ hợp phím Alt+Numpad đến Notepad, Corel, Illus... mà không bị lỗi.
Hơn nữa, phần mềm bạn ấy vẫn dùng clipboard trong một số chương trình.

[ko0ls92]

bạn ơi mình viết bằng vb 2012 thì nó báo lỗi ở App.hInstance thì phải sửa thế nào?

[HaiVB6]

@ko0ls92: Đây là VB6 bạn nhớ!

[Hong Hai]

Xin chào các anh em. Cho mình hỏi cái nầy nhe: Khi hook chuột và bàn phím được rồi, làm sao để khi mình nhấn Shift + chuột phải trên một chương trình khác nó không xổ xuống Popup menu phụ của chương trình đó. ví dụ giống như chương trình English Study 3.0. Xin cảm ơn nhiều

[Hong Hai]

Bạn "truongphu" ơi cho mình xin ý kiến giúp đỡ đi.