[转发]将Delphi的对象方法设为回调函数

心血来潮，为了实现更好的通用性和封装性，需要把类方法作为回调函数，搜得一篇好文，节选转发。命名似乎应该是MethodToCallback才合适，可惜调试时总是报错，debugging。

原文地址：http://blog.csdn.net/linzhengqun/article/details/1451088

   
  Win32的API有一些需要回调函数，说白了就是函数指针，比如钩子，列举窗口等等。如果我们要对这些技术进行面向对象的封装，就要遇到一些难题。拿钩子来说，假设我们要封装一个键盘钩子，设计一个TKeyboard
Hook类，并提供一个Active属性，如果Active属性为True，就调用SetWindowsHookEx安装一个键盘钩子，如果Active为False，就调用UnhookWindowsHookEx卸载键盘钩子，一切看起来都很好，但是调用SetWindowHookEx时需要提供一个HOOKPROC类型的回调函数，而我们并不能用一个对象的方法去作为回调函数传进去。如果有一种方法，能将普通的回调函数转换成对象的方法，那将是很棒的事情，其实VCL的MakeObjectInstance函数已经为我们开了先河，尽管它只是转换了窗口的回调函数，但对于一般的回调函数，我们同样可以仿照着做。

上文中提到过在同一种调用规则下，Win32的API与对象方法之间的差别，仅有的一点就是多了个Self的隐藏参数。由于MakeObjectInstance只是针对窗口的回调函数，参数是确定的，所以可以多做一些功夫，把StdCall转成Register调用规则。但扩展到所有的回调函数，情况就复杂得多了，你不知道这个回调函数的参数个数，因此没法进行调用规则的转换。既然如此，我们退一步，让对象方法必须也是StdCall调用规则，作这一让步并不需要付出多大的代价，你只需要把这个对象方法作为中转站，在方法里面调用Register版的方法即可，而剩下的事情由编译器帮我们做就行了。

基本的原理与上文的描述是很相似的，即提供一个内存块，内存块中保留着一段机器指令，这段指令最终能够调用到对象的指定方法。声明一个指向这个内存块的指针，将它作为回调函数传进API中。

在我即将完成这个有趣的事情而感到兴奋时，我看到网上已经有人实现了这样的转换，那就是大富翁的SaveTime，我在他的2004学习笔记中看到了“让类成员函数成为Windows回调函数的方法”，原来在两年多前就有人完成了这样的事情，看来我的此举是有些多余了，我认真看了Savetime的实现方法，基本的思路是差不多的，不过他写到内存块中的机器指令似乎不是很好，他的指令是这样：

MOV
EAX, [ESP];          //栈顶的值存到EAX中，此时栈顶的值即是回调函数返回地址

PUSH
EAX;           //将EAX入栈，

MOV
EAX, ObjectAddr;

MOV
[ESP+4], EAX;       //将对象地址作为对象方法的第一个参数

JMP
FunctionAddr;        //跳到对象方法去

这段指令实现的功能与我原来想的一样，我们知道在调用API时，要先将参数从右到左的入栈，然后调用函数。我们假设Windows调用了回调函数，执行点到了上面的代码，此时栈顶是回调函数的返回地址，下面则是回调函数所需要的参数，那么这段指令就是将回调函数的返回地址下移一个栈值，再将对象指针存到函数返回地址原来的位置，先后两种情况的堆栈是这样的：

如图2所示，此时已经完成了调用对象方法所需要的一切工作，接下来跳到对象方法的入口点去就行了。

这段代码的思路是正确的，不过我认为有一点值得考虑，就是EAX，如果之前EAX的值是有用的，那么执行这段指令之后，它的值就被破坏了，最好的情况就是不要使用寄存器，我将指令优化了一下，成了下面这样子：

push  [ESP]

mov   [ESP+4], ObjectAddr

jmp   MethodAddr

现在只需要三条指令就可以完成了，现实的功能是一样，从机器指令的大小来算，Savetime的需要18字节，而我的指令只需要16字节，所以在空间方面也有所减少。由此看来，我所做的并非无用功呀，呵呵！

至此已经万事具备，应该将代码列出来了，我写了一个CallbackToMethod的单元，这个单元具有一定的通用性，可以应用到你需要的地方去，请看下面的代码：

01 unit CallBackToMethod;
02 
03 {*******************************************
04  * brief: 回调函数转对象方法的实现
05  * autor: linzhenqun
06  * date:  2006-12-18
07  * email: linzhengqun@163.com
08 ********************************************}
09 {
10 说明：本单元的实现方法是一种比较安全的方式，其中不破坏任何寄存器的值，并且
11       指令的大小只有16字节。
12 使用：下面是推荐的使用方法
13       1. 在类中保存一个指针成员 P: Pointer
14       2. 在类的构造函数中创建指令块：
15          var
16            M: TMethod;
17          begin
18            M.Code := @MyMethod;
19            M.Data := Self;
20            P := MakeInstruction(M);
21          end;
22       3. 调用需要回调函数的API时，直接传进P即可，如：
23          HHK := SetWindowsHookEx(WH_KEYBOARD, P, HInstance, 0);
24       4. 在类的析构函数中释放指令块
25          FreeInstruction(P);
26 注意：作为回调函数的对象方法必须是StdCall调用规则
27 }
28 
29 interface
30 
31 (* 创建回调函数转对象方法的指令块 *)
32 function MakeInstruction(Method: TMethod): Pointer;
33 (* 消毁指令块 *)
34 procedure FreeInstruction(P: Pointer);
35 
36 implementation
37 
38 uses SysUtils;
39 
40 type
41   {
42     指令块中的内容相当于下面的汇编代码：
43     ----------------------------------
44     push  [ESP]
45     mov   [ESP+4], ObjectAddr
46     jmp   MethodAddr
47     ----------------------------------
48   }
49   PInstruction = ^TInstruction;
50   TInstruction = packed record
51     Code1: array [0..6] of byte;
52     Self: Pointer;
53     Code2: byte;
54     Method: Pointer;
55   end;
56 
57 function MakeInstruction(Method: TMethod): Pointer;
58 const
59   Code: array[0..15] of byte =
60    ($FF,$34,$24,$C7,$44,$24,$04,$00,$00,$00,$00,$E9,$00,$00,$00,$00);
61 var
62   P: PInstruction;
63 begin
64   New(P);
65   Move(Code, P^, SizeOf(Code));
66   P^.Self := Method.Data;
67   P^.Method := Pointer(Longint(Method.Code)-(Longint(P)+SizeOf(Code)));
68   Result := P;
69 end;
70 
71 procedure FreeInstruction(P: Pointer);
72 begin
73   Dispose(P);
74 end;
75 
76 end.

第60行是机器指令，实现的功能就是注释中的汇编，请不要被这些数字吓倒，只要先写好汇编，用CPU窗口一查就知道了，至少我就是这么做的。

在上文中曾说到封装一个键盘钩子，下面就是一个简单的实现版本：

01 unit HookKeyBoard;
02 
03 interface
04 uses
05   Windows, Messages, Classes, Forms, Controls, CallBackToMethod;
06 
07 type
08   TKeyEventEx = procedure(Sender: TObject; IsDown: Boolean;
09     ShiftState: TShiftState; Key: Word) of object;
10 
11   TKeyBoardHook = class
12   private
13     HHK: HHOOK;
14     P: Pointer;
15     FActive: Boolean;
16     FKeyEvent: TKeyEventEx;
17     procedure SetActive(const Value: Boolean);
18     function KeyboardProc(code: Integer;
19       wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
20   protected
21     function DoKeyEvent(IsDown: Boolean; ShiftState: TShiftState;
22       Key: Word): Boolean; virtual;
23   public
24     constructor Create;
25     destructor Destroy; override;
26     property Active: Boolean read FActive write SetActive;
27     property OnKeyEvent: TKeyEventEx read FKeyEvent write FKeyEvent;
28   end;
29 
30 implementation
31 
32 uses SysUtils;
33 
34 { TKeyBoardHook }
35 
36 constructor TKeyBoardHook.Create;
37 var
38   M: TMethod;
39 begin
40   M.Code := @TKeyBoardHook.KeyboardProc;
41   M.Data := Self;
42   P := MakeInstruction(M);
43 end;
44 
45 destructor TKeyBoardHook.Destroy;
46 begin
47   SetActive(False);
48   FreeInstruction(P);
49   inherited;
50 end;
51 
52 function TKeyBoardHook.DoKeyEvent(IsDown: Boolean;
53   ShiftState: TShiftState; Key: Word): Boolean;
54 begin
55   if Assigned(FKeyEvent) then
56     FKeyEvent(Self, IsDown, ShiftState, Key);
57   Result := False;
58 end;
59 
60 function TKeyBoardHook.KeyboardProc(code: Integer; wParam: WPARAM;
61   lParam: LPARAM): LRESULT;
62 var
63   IsKeyDown: Boolean;
64   ShiftState: TShiftState;
65   CharCode: Word;
66 begin
67   if code >= 0 then
68   begin
69     ShiftState := KeyDataToShiftState(lParam);
70     CharCode := LOWORD(wParam);
71     IsKeyDown := lParam and $80000000 = 0;
72     if DoKeyEvent(IsKeyDown, ShiftState, CharCode) then
73     begin
74       Result := 1;
75       Exit;
76     end;
77   end;
78   Result := CallNextHookEx(HHK, code, wParam, lParam);
79 end;
80 
81 procedure TKeyBoardHook.SetActive(const Value: Boolean);
82 begin
83   if FActive <> Value then
84   begin
85     if Value then
86     begin
87       HHK := SetWindowsHookEx(WH_KEYBOARD, P, HInstance, 0);
88       if HHK = 0 then
89         raise Exception.Create('can not install a keyboard hook');
90     end
91     else
92       UnhookWindowsHookEx(HHK);
93     FActive := Value;
94   end;
95 end;
96 
97 end.

代码中没有作什么注释，那不是我们的重点。可以覆盖DoKeyEvent方法，以实现功能更丰富的键盘钩子类。