将Delphi的对象方法设为回调函数

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

jmpMethodAddr

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

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

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

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

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

01unitHookKeyBoard;
02
03interface
04uses
05Windows,Messages,Classes,Forms,Controls,CallBackToMethod;
06
07type
08TKeyEventEx=procedure(Sender:TObject;IsDown:Boolean;
09ShiftState:TShiftState;Key:Word)ofobject;
10
11TKeyBoardHook=class
12private
13HHK:HHOOK;
14P:Pointer;
15FActive:Boolean;
16FKeyEvent:TKeyEventEx;
17procedureSetActive(constValue:Boolean);
18functionKeyboardProc(code:Integer;
19wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
20protected
21functionDoKeyEvent(IsDown:Boolean;ShiftState:TShiftState;
22Key:Word):Boolean;virtual;
23public
24constructorCreate;
25destructorDestroy;override;
26propertyActive:BooleanreadFActivewriteSetActive;
27propertyOnKeyEvent:TKeyEventExreadFKeyEventwriteFKeyEvent;
28end;
29
30implementation
31
32usesSysUtils;
33
34{TKeyBoardHook}
35
36constructorTKeyBoardHook.Create;
37var
38M:TMethod;
39begin
40M.Code:=@TKeyBoardHook.KeyboardProc;
41M.Data:=Self;
42P:=MakeInstruction(M);
43end;
44
45destructorTKeyBoardHook.Destroy;
46begin
47SetActive(False);
48FreeInstruction(P);
49inherited;
50end;
51
52functionTKeyBoardHook.DoKeyEvent(IsDown:Boolean;
53ShiftState:TShiftState;Key:Word):Boolean;
54begin
55ifAssigned(FKeyEvent)then
56FKeyEvent(Self,IsDown,ShiftState,Key);
57Result:=False;
58end;
59
60functionTKeyBoardHook.KeyboardProc(code:Integer;wParam:WPARAM;
61lParam:LPARAM):LRESULT;
62var
63IsKeyDown:Boolean;
64ShiftState:TShiftState;
65CharCode:Word;
66begin
67ifcode>=0then
68begin
69ShiftState:=KeyDataToShiftState(lParam);
70CharCode:=LOWORD(wParam);
71IsKeyDown:=lParamand$80000000=0;
72ifDoKeyEvent(IsKeyDown,ShiftState,CharCode)then
73begin
74Result:=1;
75Exit;
76end;
77end;
78Result:=CallNextHookEx(HHK,code,wParam,lParam);
79end;
80
81procedureTKeyBoardHook.SetActive(constValue:Boolean);
82begin
83ifFActive<>Valuethen
84begin
85ifValuethen
86begin
87HHK:=SetWindowsHookEx(WH_KEYBOARD,P,HInstance,0);
88ifHHK=0then
89raiseException.Create('cannotinstallakeyboardhook');
90end
91else
92UnhookWindowsHookEx(HHK);
93FActive:=Value;
94end;
95end;
96
97end.

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