Помогите с API Mouse Hooks

[Matt]

Возникла необходимость использовать API Hooks для перехвата мыши, нашёл не мало примеров, но так и не смог заставить ни один работать. Буду рад если покажете пару рабочих примеров. Интересует алгоритм отслеживающий нажатие кнопок мыши (WM_RBUTTONDOWN и прочие) и использование глобальных хуков ( JournalHooks ), т.е. тех, что работают также вне активного окна. Заранее спасибо.

[HotKitten]

и всё-таки на форуме это обсуждалось, в поиске ты быстрее всё найдёшь

[Matt]

и всё-таки на форуме это обсуждалось, в поиске ты быстрее всё найдёшь

Искал, примеры для МЫШИ в XP не работают. Хуки на клавиатуру работают, но у меня заморочка именно с МЫШЬЮ. Так что продолжим...

[HotKitten]

был где-то у меня один примерчик для работы с мышью,
только я с такими вещами никогда не сталкивался, но примерчик держу у себя вдруг пригодится...
а клики через GetAsyncKeyState(vbRightButton) можно поймать
смотря что именно тебе надо

[Matt]

А конкретно мне нужно следующее (привожу в упрощённом виде):
Ставим хук на событие "движение мыши" (WM_MOUSEMOVE или ещё что), и по событию запрашиваем координаты мыши, если координаты равны заданному значению, перемещаем указатель мыши в указанное место. Дело в том, что такой алгоритм почему-то на VB получается КРАЙНЕ медленным и при быстром перемещении мыши указатель не перемещается, только при достаточно медленном. Пять баллов тому. кто решил/решит проблему.

[HotKitten]

только я с такими вещами никогда не сталкивался, но примерчик держу у себя вдруг пригодится...

[keks-n]

Перехватывай API GetMessage (возвращаемое значение), там по любому вылезать должно.

[Matt]

Перехватывай API GetMessage (возвращаемое значение), там по любому вылезать должно.

А примеры можно?

[Tarantul]

Дело в том, что такой алгоритм почему-то на VB получается КРАЙНЕ медленным и при быстром перемещении мыши указатель не перемещается, только при достаточно медленном.

Скорее всего, что отлавливание событий проблему не решит. Намного лучше использовать GetAsyncKeyState(или какая-то другая функция в этом роде), вызывать его с частотой 100 раз в секунду или больше, тогда можно отследить положение мыши в любой момент времени. Для того, чтоб вызывать функцию с такой частотой, можно использовать таймер.

[Matt]

Эхе-хе, Tarantul, запрашивая координаты курсора мыши каждые 100 раз в секунду вы его не поймаете, гарантирую, так как я не смог его поймать и на скорости в 1000/секунды (т.е. 1мс - минимально допустимая величина установки таймера в VB). С таймером здесь ловить нечего, но похоже хуки не особо быстрее...

Может кто накидает исходник, проверит и всё-таки выложит?
Неужели не возможно?

[keks-n]

Может кто накидает исходник, проверит и всё-таки выложит?

Исходник? Да вот он! Там тока код DLL'ки чуток поправить, да прогу-клиента на VB перевести...

[Tarantul]

Эхе-хе, Tarantul, запрашивая координаты курсора мыши каждые 100 раз в секунду вы его не поймаете, гарантирую, так как я не смог его поймать и на скорости в 1000/секунды (т.е. 1мс - минимально допустимая величина установки таймера в VB). С таймером здесь ловить нечего, но похоже хуки не особо быстрее...

На самом деле проверять состояние мыши - способ самый надежный, получше всех хуков и Event'ов вместе взятых. Другое дело что таймер при интервале < 50 работает очень нестабильно. Здесь нужен четкий цикл с контролем времени, но его реализовать проблематично. Надо либо делать твою прогу, основаную на бесконечном цикле, либо создавать еще один поток в присоединенном DLL. Первый способ легче, но все равно придеться менять структуру программы

А если тебе просто надо знать, прошел ли указатель мыши через заданную точку, то просто запомни предпоследние координаты мыши, и проведи между предыдущей и текущей точкой линию. Дальше остаеться проверить, пренадлежит ли целевая точка этой линии

[keks-n]

Вот, DLL переделал, клиента перевёл. Для отлова WM_MOUSEHOOK формой использовал SubClasser (спасибо GSerg'у), ибо самому писать лень.

[KVG]

Всё-таки API Hook (см. 1-ый пост) устанавливается с помощью:

Код: Выделить всё

ghHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0&, IdThread)
'где ghHook – дескриптор устанавливаемой ловушки;
'Public Const WH_MOUSE = 7;
'dwThreadId - идентификатор текущего потока, получаемый с помощью API: GetCurrentThreadId
'MouseProc – пишем сами, если в своём модуле, то получим локальную, если в .dll – глобальную ловушку.
'Шаблон для локальной процедуры MouseProc:
Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'где lParam - Pointer to a MOUSEHOOKSTRUCT
'Первый член этой структуры - pt - это указатель на POINTAPI, в которой хранятся текущие координаты курсора мыши.

А в вышестоящем посте реализован «субклассинг».

[KVG]

Вот MouseProc для локальной ловушки:

Код: Выделить всё

Dim mhs As MOUSEHOOKSTRUCT
Type POINTAPI
        x As Long     ‘contains x- and y-coordinates of the cursor, in screen coordinates
        y As Long
End Type
Type MOUSEHOOKSTRUCT
        pt As POINTAPI
        hwnd As Long
        wHitTestCode As Long    'Specifies the hit-test value (see WM_NCHITTEST message)
        dwExtraInfo As Long     'Specifies extra information associated with the message
End Type
‘*****************************************************************************************
Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If ncode < 0 Then   'обязательно для ncode < 0
        MouseProc = CallNextHookEx(ghHook, ncode, wParam, lParam)
        Exit Function
    End If
   
    CopyMemory mhs.pt.x, ByVal lParam, Len(mhs)  ‘CopyMemory продекларируйте заранее
    ‘
    ‘теперь в mhs.pt.x и mhs.pt.y  у Вас постоянно будут текущие координаты курсора
    ‘в wParam - будет информация о нажатиях правой и левой кнопках мыши
    ‘проверяйте их здесь как Вам угодно будет
    ‘
    'передача сообщения по цепочке ловушек
    MouseProc = CallNextHookEx(ghHook, ncode, wParam, lParam)
End Function

Для глобальной ловушки всё это необходимо написать на С++.

[hCORe]

Можно и на VB. Ищи посты Тёмыча на эту тему.

[Matt]

Покопался в коде KVG, довёл до работоспособного состояния, код запускается, но ничего не происходит. Привожу код:

Форма:

Private Sub Form_Load()
hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0&, IdThread)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub

Модуль:


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 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 Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Const WH_MOUSE = 7

Dim mhs As MOUSEHOOKSTRUCT
Type POINTAPI
x As Long
y As Long
End Type
Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As Long
wHitTestCode As Long 'Specifies the hit-test value (see WM_NCHITTEST message)
dwExtraInfo As Long 'Specifies extra information associated with the message
End Type
'*****************************
Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
MouseProc = CallNextHookEx(hHook, nCode, wParam, lParam)
Exit Function
End If

CopyMemory mhs, pt.x, ByVal lParam, Len(mhs)

If mhs.pt.x = 200 Then MsgBox "Gotcha!", vbOKOnly 'Пытаемся поймать X равный 200px

MouseProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function


Что не так ?

[KVG]

‘Продекларировать ещё:

Код: Выделить всё

Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Long

‘В Form_Load добавить:

Код: Выделить всё

Dim IdThread As Long
IdThread = GetCurrentThreadId
    If   hHook = 0 Then hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0&, IdThread)
‘hHook соответственно в глоб. переменную.

В CopyMemory mhs, pt.x, ByVal lParam, Len(mhs) исправить « mhs.pt.x »
Возможно, это и заработает. У меня лично работает подобное и отображает тек. координаты в TextBox на формочке, на ней же кнопки Hook и UnHook, ComboBox с возможностью выбора др. типов ловушек (WH_KEYBOARD и ещё), соответственно проверок дополнительных получается очень много… Кстати, с вызовом MsgBox нужно по-осторожнее в данном случае – лучше не связываться.
Пример из msdn установки 7-ми типов ловушек _http: // msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/usinghooks.asp но реализовать приближенно к первоисточнику на VB у меня не получается.
Кстати, у меня If mhs.pt.x = 200 Then MsgBox 200 - ловится - через раз - при быстром перемещении мыши не срабатывает, при медленном - да, т.е. MsgBox лучше не использовать!

[Matt]

To KVG:
Я добавил в модуль:

Код: Выделить всё

Public hHook As Long
Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Long

В Form_Load:

Код: Выделить всё

Dim IdThread As Long
IdThread = GetCurrentThreadId
    If   hHook = 0 Then hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0&, IdThread)

исправил «mhs.pt.x» в CopyMemory, но при запуске кода, VB вылетает.

Пример из msdn установки 7-ми типов ловушек
_http: // msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/usinghooks.asp

Ссылка не работает.

Кстати, у меня If mhs.pt.x = 200 Then MsgBox 200 - ловится - через раз - при быстром перемещении мыши не срабатывает, при медленном - да, т.е. MsgBox лучше не использовать!

Дело здесь, по-моему, не в MsgBox, а именно в скорости определения координат мыши, можешь(ете) попробывать что-нибудь другое вместо MsgBox. Тормозит и всё. Это - проблема номер один. У кого какие идеи? Как добиться приемлемой скорости?

[KVG]

1.) Про ссылку чё-то я не понял ??? копируем начиная с msdn. и далее… и всё работает (до этого лишние пробелы вставлены – разве не видно, что ссылка не прямая) ???
2.) Про «тормозит…» – быстрее перехватить координаты в данном случае, чем с помощью SetWindowsHookEx, можно, возможно, с помощью Native API или ещё как-нибудь более сложнее. Данная функция встроена в ОС и мониторит очередь системных сообщений на предмет в данном случае «мышиных» событий. А «перехваты» встроенные в VB с наибольшей степенью вероятности реализованы через данную функцию ОС. Т.е. быстрее-то некуда… А вот вызывать при перехвате «тормозной» MsgBox, когда сообщения о координатах мыши при её перемещении «валятся» 10-ми и 100-ми ??? Зачем ??? После 1-го же MsgBox, естественно, всё будет "висеть". Конечно же, известная вещь, что и оператор If из VB – тоже достаточно медлителен.
У меня в TextBox_е координаты «бегут» через каждый (или почти) пиксель перемещения. Внутри MouseProc после CopyMemory я ставлю:

s = "MsgID(wParam): " & CStr(wParam) & " Window(hwnd): " & CStr(mhs.hwnd) & "; x: " & CStr(mhs.pt.x) & _
"; y: " & CStr(mhs.pt.y) & "; wHitTestCode: " & CStr(mhs.wHitTestCode) & "; dwExtraInfo: " & CStr(mhs.dwExtraInfo)
frmMain.txtHook.Value = s

где s определил заранее: Public s As String. И скорость определения и отображения координат в TextBox на формочке (frmMain.txtHook) – быстрее некуда получается.
Не исключено, кстати, что при быстром перемещении мыши сообщения в ОС генерируются не через 1 пиксель, а более, тогда вместо mhs.pt.x=200 нужно менее «жесткое» условие придумывать… В конце концов, вся инфа о координатах мыши в системных сообщениях, нет сообщения – значит нет события (получено искомое сообщение) – а значит нет и искомой инфы.
3.) «VB» вылетает при отладке hook_ов ? – обычное явление – нужно продолжать отладку… перед MouseProc выполнять по-шагово, внутри MouseProc «закомментировать» по-очереди строки, тут приёмы у всех свои… Часто «валится», кстати в CopyMemory… (очень внимательно следует её проверять - казалось бы одна строчка, но с ней часто приходится долго "бороться"). Условия вставить, так, чтоб несколько мышыных hook_ов одновременно не устанавливались, чтоб обязательно hook снимался по завершении. Если уже 2 hook_а (одинаковых) при отладке поставил - перезагружай ОС.