123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253 |
- {
- Free Pascal port of the OpenPTC C++ library.
- Copyright (C) 2001-2003 Nikolay Nikolov ([email protected])
- Original C++ version by Glenn Fiedler ([email protected])
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- }
- Type
- PWin32Hook_Lookup = ^TWin32Hook_Lookup;
- TWin32Hook_Lookup = Record
- window : HWND;
- wndproc : DWord;
- hook : Array[0..15] Of TWin32Hook;
- count : Integer;
- End;
- Const
- TWin32Hook_m_count : Integer = 0;
- TWin32Hook_m_cached : PWin32Hook_Lookup = Nil;
- TWin32Hook_m_monitor : TWin32Monitor = Nil;
- Var
- { TWin32Hook_m_hook : HHOOK;}
- TWin32Hook_m_registry : Array[0..15] Of TWin32Hook_Lookup;
- Function TWin32Hook_hook(hwnd : HWND; msg : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
- Var
- lookup : PWin32Hook_Lookup;
- i : Integer;
- Begin
- { enter monitor }
- TWin32Hook_m_monitor.enter;
- { lookup pointer }
- lookup := Nil;
- { check cached lookup if valid }
- If (TWin32Hook_m_cached <> Nil) And (TWin32Hook_m_cached^.window = hwnd) Then
- { cached lookup match }
- lookup := TWin32Hook_m_cached
- Else
- Begin
- { search for matching window }
- For i := 0 To TWin32Hook_m_count - 1 Do
- { check for lookup window match }
- If TWin32Hook_m_registry[i].window = hwnd Then
- Begin
- { setup cached lookup }
- TWin32Hook_m_cached := @TWin32Hook_m_registry[i];
- { setup lookup }
- lookup := TWin32Hook_m_cached;
- { break }
- Break;
- End;
- {$IFDEF DEBUG}
- { check for search failure }
- If lookup = Nil Then
- Raise TPTCError.Create('TWin32Hook window lookup search failure!');
- {$ENDIF}
- End;
- { result value }
- TWin32Hook_hook := 0;
- { iterate all hooks for this window }
- For i := lookup^.count - 1 DownTo 0 Do
- Begin
- { call hook window procedure }
- TWin32Hook_hook := lookup^.hook[i].WndProc(hwnd, msg, wParam, lParam);
- { check result value ? }
- {If result = True Then Break;}
- End;
- { check result }
- {If result <> True Then}
- { call original window procedure }
- result := CallWindowProc(WNDPROC(lookup^.wndproc), hwnd, msg, wParam, lParam);
- { leave monitor }
- TWin32Hook_m_monitor.leave;
- End;
- Constructor TWin32Hook.Create(window : HWND; thread : DWord);
- Begin
- { setup data }
- m_window := window;
- m_thread := thread;
- { add to registry }
- add(m_window, m_thread);
- End;
- Destructor TWin32Hook.Destroy;
- Begin
- { remove from registry }
- remove(m_window, m_thread);
- Inherited Destroy;
- End;
- Procedure TWin32Hook.Add(window : HWND; thread : DWord);
- Var
- index, insert : Integer;
- Begin
- { enter monitor }
- TWin32Hook_m_monitor.enter;
- { invalidate cache }
- TWin32Hook_m_cached := Nil;
- { registry index }
- index := 0;
- { iterate registry }
- While index < TWin32Hook_m_count Do
- Begin
- { search for existing window hook }
- If TWin32Hook_m_registry[index].window = window Then
- { match }
- Break;
- { next }
- Inc(index);
- End;
- { check results }
- If index <> TWin32Hook_m_count Then
- Begin
- { get insertion point for hook }
- insert := TWin32Hook_m_registry[index].count;
- { increase hook count }
- Inc(TWin32Hook_m_registry[index].count);
- {$IFDEF DEBUG}
- { Check for maximum hook count }
- If TWin32Hook_m_registry[index].count > (High(TWin32Hook_m_registry[index].hook) + 1) Then
- Raise TPTCError.Create('TWin32Hook too many hooks created!');
- {$ENDIF}
- { insert hook in registry }
- TWin32Hook_m_registry[index].hook[insert] := Self;
- End
- Else
- Begin
- { setup new lookup }
- TWin32Hook_m_registry[index].wndproc := GetWindowLong(window, GWL_WNDPROC);
- TWin32Hook_m_registry[index].window := window;
- TWin32Hook_m_registry[index].hook[0] := Self;
- TWin32Hook_m_registry[index].count := 1;
- { increase lookup count }
- Inc(TWin32Hook_m_count);
- {$IFDEF DEBUG}
- { check for maximum count }
- If TWin32Hook_m_count > (High(TWin32Hook_m_registry) + 1) Then
- Raise TPTCError.Create('TWin32Hook too many lookups created!');
- {$ENDIF}
- { set window procedure to hook procedure }
- SetWindowLong(window, GWL_WNDPROC, DWord(@TWin32Hook_hook));
- End;
- { leave monitor }
- TWin32Hook_m_monitor.leave;
- End;
- Procedure TWin32Hook.Remove(window : HWND; thread : DWord);
- Var
- index, i, j : Integer;
- Begin
- { enter monitor }
- TWin32Hook_m_monitor.enter;
- { invalidate cache }
- TWin32Hook_m_cached := Nil;
- { registry index }
- index := 0;
- { iterate registry }
- While index < TWin32Hook_m_count Do
- Begin
- { check for window match }
- If TWin32Hook_m_registry[index].window = window Then
- Begin
- { search for Self }
- For i := 0 To TWin32Hook_m_registry[index].count Do
- { check hook }
- If TWin32Hook_m_registry[index].hook[i] = Self Then
- Begin
- { remove this hook (quite inefficient for high count...) }
- For j := i To TWin32Hook_m_registry[index].count - 2 Do
- TWin32Hook_m_registry[index].hook[j] :=
- TWin32Hook_m_registry[index].hook[j + 1];
- { decrease hook count }
- Dec(TWin32Hook_m_registry[index].count);
- { break }
- Break;
- End;
- { check remaining hook count }
- If TWin32Hook_m_registry[index].count = 0 Then
- Begin
- { restore original window procedure }
- SetWindowLong(window, GWL_WNDPROC, TWin32Hook_m_registry[i].wndproc);
- { remove this lookup (quite inefficient for high count...) }
- For i := index To TWin32Hook_m_count - 2 Do
- TWin32Hook_m_registry[i] := TWin32Hook_m_registry[i + 1];
- { decrease count }
- Dec(TWin32Hook_m_count);
- End;
- { break }
- Break;
- End;
- { next }
- Inc(index);
- End;
- { leave monitor }
- TWin32Hook_m_monitor.leave;
- End;
|