К сожалению, он был сложен для моего понимания и сильно запутан трейными часиками
К тому же, пугал меня .tlb-шкой, которая по-прежнему остаётся для меня в разряде белой магии.
Да простит меня уважаемый автор, я выбросил из примера всё, что не относится к хуку как таковому (и часики, и субклассинг и tlb)
Помогите, пожалуйста, разобраться, что я сделал не так и что не так понял: хук на своё окно ставится, а на чужие - нет... Причём, рушит эти самые чужие проги, а сам не падает
Библиотека:
- Код: Выделить всё
'clsHook
Option Explicit
Public Property Get AddressOfHookProc() As Long
AddressOfHookProc = i(AddressOf HookProc) 'получить из класса адрес процедуры, которая на самом деле в модуле
End Property
Private Function i(ByVal x As Long) As Long
i = x
End Function
Public Property Get DllBase() As Long
DllBase = App.hInstance
End Property
Public Sub implimentsMe(h As iHook) 'подключить интерфейс
Set myHook = h
myHook.HookProc 0, 0, 0 'показать, что подключился
End Sub
- Код: Выделить всё
'iHook
Option Explicit
Public Function HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
End Function
- Код: Выделить всё
'modHook
Option Explicit
Public myHook As iHook 'интерфейс, который будет передавать события нашего хука
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Function HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
myHook.HookProc code, wParam, lParam
HookProc = CallNextHookEx(0, code, wParam, lParam)
End Function
Программа:
- Код: Выделить всё
'form1
Option Explicit
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 GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Dim hw As Long, newId As Long
Private hHook As Long
Const WH_KEYBOARD = 2&
Implements iHook
Private Sub Form_Load()
implimentsMe Me ' сообщаем в длл, что события хука нужно слать нам
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOfHookProc _
, DllBase, App.ThreadID) 'ставим хук на самого себя
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
timer1.Interval = 200 'по таймеру проверяю, не изменился ли фокус ввода
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx hHook
End Sub
Private Function iHook_HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Caption = Hex(wParam) & " " & Hex(lParam)
End Function
Private Sub timer1_Timer()
Dim h As Long
h = GetForegroundWindow 'окно верхнего уровня
If h <> hwnd Then ' если это не мы
If hw <> h Then ' и не то окно, которое мы уже смотрим
hw = h
newId = GetWindowThreadProcessId(hw, 0)
If hHook Then UnhookWindowsHookEx hHook
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOfHookProc _
, DllBase, newId) ' пытаемся переставить хук на другой процесс
End If
End If
End Sub
Добавлено позже:
Кстати - СПАСИБО ВСЕМ
- я таки допеределывал пример! см. в конце этой темы. И даже до состояния готового контрола! см.Кирпичи
