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
Code: Select all
Option Explicit Private Sub Form_Unload(Cancel As Integer) Call UnhookWindowsHookEx(hKbdHook)End Sub
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
Code: Select all
Option Explicit Private Sub Form_Unload(Cancel As Integer) Call UnhookWindowsHookEx(hKbdHook) End Sub
Đâ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
Code: Select all
Option Explicit Private Sub Form_Unload(Cancel As Integer) Call UnhookWindowsHookEx(hKbdHook)End Sub
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
Code: Select all
Private Sub Form_Unload(Cancel As Integer) If hHook <> 0 Then Call UnhookWindowsHookEx(hHook)End Sub