Как сделать хук на мышь?
Имеется в виду на нажатие кнопок мышки (т.е. на нажатие и отпускание кнопки), координаты я сделал через GetCursorPos.
Данный пример покажет, как можно установить глобальный хук на мышь, и ваша программа будет считать количество нажатий на клавиши мыши и на колесо прокрутки. Также ваша программа будет реагировать на нажатие любой клавиши клавиатуры.
Также данный пример в окне DEBUG располагает информацию о местоположении курсора.
Добавьте модуль в вашу программу и также расположите на форме 5 элементов TextBox.
'КОД ФОРМЫ
Private Sub Form_Load()
Text1 = "0"
Text2 = "0"
Text3 = "0"
Text4 = "0"
Text5 = "0"
hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, 0, 0)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub
'КОД МОДУЛЯ
Option Explicit
Public Type POINTAPI
x As Long
y As Long
End Type
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Public Const WH_JOURNALRECORD = 0
Type CBTACTIVATESTRUCT
fMouse As Long
hWndActive As Long
End Type
Dim CBT As CBTACTIVATESTRUCT
Public hHook As Long
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
CopyMemory CBT, ByVal lParam, Len(CBT)
Select Case CBT.fMouse
Case WM_MOUSEMOVE
Dim CurPos As POINTAPI
GetCursorPos CurPos
Debug.Print "Move at pos ", CurPos.x, CurPos.y
Case WM_KEYDOWN
Form1.Text5 = Form1.Text5 + 1
Case WM_KEYUP
Debug.Print "KeyUp"
Case WM_MOUSEWHEEL
Form1.Text4 = Form1.Text4 + 1
Case WM_LBUTTONDOWN
Form1.Text1 = Form1.Text1 + 1
Case WM_LBUTTONUP
Debug.Print "LeftUp"
Case WM_RBUTTONDOWN
Form1.Text3 = Form1.Text3 + 1
Case WM_RBUTTONUP
Debug.Print "RightUp"
Case WM_MBUTTONDOWN
Form1.Text2 = Form1.Text2 + 1
Case WM_MBUTTONUP
Debug.Print "MiddleUp"
End Select
HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_SYSTEMKEYDOWN = &H104
Private Const WM_SYSTEMKEYUP = &H105
'Before you start this program, I suggest you save everything that wasn't saved yet.
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)
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 Sub Form_Activate()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Do
'Simulate a mouseclick on the cursor's position
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, cButt, dwEI
DoEvents
Loop
End Sub
Сейчас этот форум просматривают: AhrefsBot и гости: 93