[转发]将Delphi的对象方法设为回调函数
心血来潮，为了实现更好的通用性和封装性，需要把类方法作为回调函数，搜得一篇好文，节选转发。命名似乎应该是MethodToCallback才合适，可惜调试时总是报错，debugging。
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方法，以实现功能更丰富的键盘钩子类。
