Модуль:
| Visual Basic | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
| ' © Кривоус Анатолий Анатольевич (The trick), 2013
Option Explicit
Public Type POINT
X As Long
Y As Long
End Type
Public Type MSLLHOOKSTRUCT
pt As POINT
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
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
Private 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, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const HC_ACTION = 0
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WH_MOUSE_LL = &HE&
Private Const LLMHF_INJECTED = 1
Private hHook As Long
Public Sub StartHook()
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.hInstance, 0)
End Sub
Public Sub StopHook()
UnhookWindowsHookEx hHook
End Sub
Public Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
Dim hs As MSLLHOOKSTRUCT
If uCode = HC_ACTION Then
If wParam = WM_LBUTTONDOWN Then ' Нажатие
CopyMemory hs, ByVal lParam, Len(hs)
If Not CBool(hs.flags And LLMHF_INJECTED) Then
Debug.Print "Real MouseDown"
frmMain.tmrClick.Enabled = True
End If
ElseIf wParam = WM_LBUTTONUP Then ' Отпускание
CopyMemory hs, ByVal lParam, Len(hs)
If Not CBool(hs.flags And LLMHF_INJECTED) Then
Debug.Print "Real MouseUp"
frmMain.tmrClick.Enabled = False
End If
End If
End If
LowLevelMouseProc = CallNextHookEx(hHook, uCode, wParam, lParam)
End Function |
|
Форма с таймером:
| Visual Basic | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
| Option Explicit
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 Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Sub Form_Load()
StartHook
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
StopHook
End Sub
Private Sub tmrClick_Timer()
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub |
|
|