hook.inc 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253
  1. {
  2. Free Pascal port of the OpenPTC C++ library.
  3. Copyright (C) 2001-2003 Nikolay Nikolov ([email protected])
  4. Original C++ version by Glenn Fiedler ([email protected])
  5. This library is free software; you can redistribute it and/or
  6. modify it under the terms of the GNU Lesser General Public
  7. License as published by the Free Software Foundation; either
  8. version 2.1 of the License, or (at your option) any later version.
  9. This library is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12. Lesser General Public License for more details.
  13. You should have received a copy of the GNU Lesser General Public
  14. License along with this library; if not, write to the Free Software
  15. Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  16. }
  17. Type
  18. PWin32Hook_Lookup = ^TWin32Hook_Lookup;
  19. TWin32Hook_Lookup = Record
  20. window : HWND;
  21. wndproc : DWord;
  22. hook : Array[0..15] Of TWin32Hook;
  23. count : Integer;
  24. End;
  25. Const
  26. TWin32Hook_m_count : Integer = 0;
  27. TWin32Hook_m_cached : PWin32Hook_Lookup = Nil;
  28. TWin32Hook_m_monitor : TWin32Monitor = Nil;
  29. Var
  30. { TWin32Hook_m_hook : HHOOK;}
  31. TWin32Hook_m_registry : Array[0..15] Of TWin32Hook_Lookup;
  32. Function TWin32Hook_hook(hwnd : HWND; msg : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
  33. Var
  34. lookup : PWin32Hook_Lookup;
  35. i : Integer;
  36. Begin
  37. { enter monitor }
  38. TWin32Hook_m_monitor.enter;
  39. { lookup pointer }
  40. lookup := Nil;
  41. { check cached lookup if valid }
  42. If (TWin32Hook_m_cached <> Nil) And (TWin32Hook_m_cached^.window = hwnd) Then
  43. { cached lookup match }
  44. lookup := TWin32Hook_m_cached
  45. Else
  46. Begin
  47. { search for matching window }
  48. For i := 0 To TWin32Hook_m_count - 1 Do
  49. { check for lookup window match }
  50. If TWin32Hook_m_registry[i].window = hwnd Then
  51. Begin
  52. { setup cached lookup }
  53. TWin32Hook_m_cached := @TWin32Hook_m_registry[i];
  54. { setup lookup }
  55. lookup := TWin32Hook_m_cached;
  56. { break }
  57. Break;
  58. End;
  59. {$IFDEF DEBUG}
  60. { check for search failure }
  61. If lookup = Nil Then
  62. Raise TPTCError.Create('TWin32Hook window lookup search failure!');
  63. {$ENDIF}
  64. End;
  65. { result value }
  66. TWin32Hook_hook := 0;
  67. { iterate all hooks for this window }
  68. For i := lookup^.count - 1 DownTo 0 Do
  69. Begin
  70. { call hook window procedure }
  71. TWin32Hook_hook := lookup^.hook[i].WndProc(hwnd, msg, wParam, lParam);
  72. { check result value ? }
  73. {If result = True Then Break;}
  74. End;
  75. { check result }
  76. {If result <> True Then}
  77. { call original window procedure }
  78. result := CallWindowProc(WNDPROC(lookup^.wndproc), hwnd, msg, wParam, lParam);
  79. { leave monitor }
  80. TWin32Hook_m_monitor.leave;
  81. End;
  82. Constructor TWin32Hook.Create(window : HWND; thread : DWord);
  83. Begin
  84. { setup data }
  85. m_window := window;
  86. m_thread := thread;
  87. { add to registry }
  88. add(m_window, m_thread);
  89. End;
  90. Destructor TWin32Hook.Destroy;
  91. Begin
  92. { remove from registry }
  93. remove(m_window, m_thread);
  94. Inherited Destroy;
  95. End;
  96. Procedure TWin32Hook.Add(window : HWND; thread : DWord);
  97. Var
  98. index, insert : Integer;
  99. Begin
  100. { enter monitor }
  101. TWin32Hook_m_monitor.enter;
  102. { invalidate cache }
  103. TWin32Hook_m_cached := Nil;
  104. { registry index }
  105. index := 0;
  106. { iterate registry }
  107. While index < TWin32Hook_m_count Do
  108. Begin
  109. { search for existing window hook }
  110. If TWin32Hook_m_registry[index].window = window Then
  111. { match }
  112. Break;
  113. { next }
  114. Inc(index);
  115. End;
  116. { check results }
  117. If index <> TWin32Hook_m_count Then
  118. Begin
  119. { get insertion point for hook }
  120. insert := TWin32Hook_m_registry[index].count;
  121. { increase hook count }
  122. Inc(TWin32Hook_m_registry[index].count);
  123. {$IFDEF DEBUG}
  124. { Check for maximum hook count }
  125. If TWin32Hook_m_registry[index].count > (High(TWin32Hook_m_registry[index].hook) + 1) Then
  126. Raise TPTCError.Create('TWin32Hook too many hooks created!');
  127. {$ENDIF}
  128. { insert hook in registry }
  129. TWin32Hook_m_registry[index].hook[insert] := Self;
  130. End
  131. Else
  132. Begin
  133. { setup new lookup }
  134. TWin32Hook_m_registry[index].wndproc := GetWindowLong(window, GWL_WNDPROC);
  135. TWin32Hook_m_registry[index].window := window;
  136. TWin32Hook_m_registry[index].hook[0] := Self;
  137. TWin32Hook_m_registry[index].count := 1;
  138. { increase lookup count }
  139. Inc(TWin32Hook_m_count);
  140. {$IFDEF DEBUG}
  141. { check for maximum count }
  142. If TWin32Hook_m_count > (High(TWin32Hook_m_registry) + 1) Then
  143. Raise TPTCError.Create('TWin32Hook too many lookups created!');
  144. {$ENDIF}
  145. { set window procedure to hook procedure }
  146. SetWindowLong(window, GWL_WNDPROC, DWord(@TWin32Hook_hook));
  147. End;
  148. { leave monitor }
  149. TWin32Hook_m_monitor.leave;
  150. End;
  151. Procedure TWin32Hook.Remove(window : HWND; thread : DWord);
  152. Var
  153. index, i, j : Integer;
  154. Begin
  155. { enter monitor }
  156. TWin32Hook_m_monitor.enter;
  157. { invalidate cache }
  158. TWin32Hook_m_cached := Nil;
  159. { registry index }
  160. index := 0;
  161. { iterate registry }
  162. While index < TWin32Hook_m_count Do
  163. Begin
  164. { check for window match }
  165. If TWin32Hook_m_registry[index].window = window Then
  166. Begin
  167. { search for Self }
  168. For i := 0 To TWin32Hook_m_registry[index].count Do
  169. { check hook }
  170. If TWin32Hook_m_registry[index].hook[i] = Self Then
  171. Begin
  172. { remove this hook (quite inefficient for high count...) }
  173. For j := i To TWin32Hook_m_registry[index].count - 2 Do
  174. TWin32Hook_m_registry[index].hook[j] :=
  175. TWin32Hook_m_registry[index].hook[j + 1];
  176. { decrease hook count }
  177. Dec(TWin32Hook_m_registry[index].count);
  178. { break }
  179. Break;
  180. End;
  181. { check remaining hook count }
  182. If TWin32Hook_m_registry[index].count = 0 Then
  183. Begin
  184. { restore original window procedure }
  185. SetWindowLong(window, GWL_WNDPROC, TWin32Hook_m_registry[i].wndproc);
  186. { remove this lookup (quite inefficient for high count...) }
  187. For i := index To TWin32Hook_m_count - 2 Do
  188. TWin32Hook_m_registry[i] := TWin32Hook_m_registry[i + 1];
  189. { decrease count }
  190. Dec(TWin32Hook_m_count);
  191. End;
  192. { break }
  193. Break;
  194. End;
  195. { next }
  196. Inc(index);
  197. End;
  198. { leave monitor }
  199. TWin32Hook_m_monitor.leave;
  200. End;