VCL Delphi Windows消息窗口函数注册 MakeObject (转自网络)

MakeObjectInstance函数是Delphi函数，这个函数的申明部分是这样的：
function MakeObjectInstance(Method: TWndMethod): Pointer;
和它相对应的另一个函数叫做FreeObjectInstance，它的申明部分是这样的：
procedure FreeObjectInstance(ObjectInstance: Pointer);

MakeObjectInstance函数在Delphi的帮助文件中并没有，但是它还是在Interface中申明了，
也就是说我们可以使用它。

要完全解释清楚这个函数的作用不是三言两语的事情，
现贴上一篇文章：

关键字:
VCL Delphi Windows消息窗口函数注册 MakeObject 汇编贴文时间
2001-7-9 17:16:31 文章类型:
原作给贴子投票
投票
cheka 原作出处:

VCL HardCore ——VCL窗口函数注册机制研究手记，兼与MFC比较

By cheka cheka@yeah.net （转载请保留此信息）

这个名字起的有些耸人听闻，无他意，只为吸引眼球而已，如果您对下列关键词有兴趣，希望不要错过本文：

1. VCL可视组件在内存中的分页式管理;

2. 让系统回调类的成员方法

3. Delphi 中汇编指令的使用

4. Hardcore

5. 第4条是骗你的

我们知道Windows平台上的GUI程序都必须遵循Windows的消息响应机制，可以简单概括如下，所有的窗口控件都向系统注册自身的窗口函数，运行期间消息可被指派至特定窗口控件的窗口函数处理。对消息相应机制做这样的概括有失严密，请各位见谅，我想赶紧转向本文重点，即在利用Object Pascali或是C++这样的面向对象语言编程中，如何把一个类的成员方法向系统注册以供回调。

在注册窗口类即调用RegisterClass函数时，我们向系统传递的是一个WindowProc 类型的函数指针

WindowProc 的定义如下

LRESULT CALLBACK WindowProc(

HWND hwnd, // handle to window

UINT uMsg, // message identifier

WPARAM wParam, // first message parameter

LPARAM lParam // second message parameter

)；

如果我们有一个控件类，它拥有看似具有相同定义的成员方法TMyControl.WindowProc,可是却不能够将它的首地址作为lpfnWndProc参数传给RegisterClass，道理很简单，因为Delphi中所有类成员方法都有一个隐含的参数，也就是Self，因此无法符合标准 WindowProc 的定义。

那么，在VCL中，控件向系统注册时究竟传递了一个什么样的窗口指针，同时通过这个指针又是如何调到各个类的事件响应方法呢？我先卖个关子，先看看MFC是怎么做的。

在调查MFC代码之前，我作过两种猜想：

一，作注册用的函数指针指向的是一个类的静态方法，

静态方法同样不需要隐含参数 this （对应 Delphi中的 Self ,不过Object Pascal不支持静态方法）

二，作注册用的函数指针指向的是一个全局函数，这当然最传统，没什么好说的。

经过简单的跟踪，我发现MFC中，全局函数AfxWndProc是整个MFC程序处理消息的“根节点”，也就是说，所有的消息都由它指派给不同控件的消息响应函数，也就是说，所有的窗口控件向系统注册的窗口函数很可能就是 AfxWndProc （抱歉没做深入研究，如果不对请指正）。而AfxWndProc 是如何调用各个窗口类的WndProc呢？

哈哈，MFC用了一种很朴素的机制，相比它那么多稀奇古怪的宏来说，这种机制相当好理解：使用一个全局的Map数据结构来维护所有的窗口对象和Handle(其中Handle为键值），然后AfxWndProc根据Handle来找出唯一对应的窗口对象（使用静态函数CWnd::FromHandlePermanent(HWND hWnd) ），然后调用其WndProc，注意WndProc可是虚拟方法，因此消息能够正确到达所指定窗口类的消息响应函数并被处理。

于是我们有理由猜想VCL也可能采用相同的机制，毕竟这种方式实现起来很简单。我确实是这么猜的，不过结论是我错了......

开场秀结束，好戏正式上演。

在Form1上放一个Button(缺省名为Button1),在其OnClick事件中写些代码，加上断点，F9运行，当停留在断点上时，打开Call Stack窗口（View->Debug Window->Call Stack，或者按Ctrl-Alt-S )可看到调用顺序如下（从底往上看，stack嘛）

( 如果你看到的 Stack 和这个不一致，请打开DCU 调试开关 Project->Options->Compiler->Use Debug DCUs, 这个开关如果不打开，是没法调试VCL源码的 )

TForm1.Button1Click(???)

TControl.Click

TButton.Click

TButton.CNCommand ((48401, 3880, 0, 3880, 0))

TControl.WndProc ((48401, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TWinControl.WndProc ((48401, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TButtonControl.WndProc ((48401, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TControl.Perform (48401,3880,3880)

DoControlMsg (3880,(no value))

TWinControl.WMComman d((273, 3880, 0, 3880, 0))

TCustomForm.WMCommand ((273, 3880, 0, 3880, 0))

TControl.WndProc ((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TWinControl.WndProc((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TCustomForm.WndProc ((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TWinControl.MainWndProc ((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

StdWndProc (3792,273,3880,3880)

可见 StdWndProc 看上去象是扮演了MFC中 AfxWndProc 的角色，不过我们先不谈它，如果你抑制不住好奇心，可以提前去看它的源码，在Forms.pas中，看到了么? 是不是特~~~~别有趣阿。

实际上，VCL在RegisterClass时传递的窗口函数指针并非指向StdWndProc。那是什么呢？

我跟，我跟，我跟跟跟，终于在Controls.pas的TWindowControl的实现代码中

（procedure TWinControl.CreateWnd;) 看到了RegisterClass的调用,hoho，终于找到组织了......别忙，发现了没，这时候注册的窗口函数是InitWndProc，看看它的定义，嗯，符合标准，再去瞧瞧代码都干了些什么。

发现这句：

SetWindowLong(HWindow, GWL_WNDPROC,Longint(CreationControl.FObjectInstance));

我Faint，搞了半天InitWndProc初次被调用（对每一个Wincontrol来说）就把自个儿给换了，新上岗的是FObjectInstance。下面还有一小段汇编，是紧接着调用FObjectInstance的，调用的理由不奇怪，因为以后调用FObjectInstace都由系统CallBack了，但现在还得劳InitWndProc的大驾去call。调用的方式有些讲究，不过留给您看完这篇文章后自个儿琢磨去吧。

接下来只能继续看FObjectInstance是什么东东，它定义在 TWinControl 的 Private 段，是个Pointer也就是个普通指针，当什么使都行，你跟Windows说它就是 WndProc 型指针 Windows 拿你也没辙。

FObjectInstance究竟指向何处呢，镜头移向 TWincontrol 的构造函数，这是FObjectInstance初次被赋值的地方。多余的代码不用看，焦点放在这句上

FObjectInstance := MakeObjectInstance(MainWndProc);

可以先告诉您，MakeObjectInstance是本主题最精彩之处，但是您现在只需知道FObjectInstance“指向了”MainWndProc，也就是说通过某种途径VCL把每个MainWndProc作为窗口函数注册了，先证明容易的，即 MainWndProc 具备窗口函数的功能，来看代码：

( 省去异常处理 )

procedure TWinControl.MainWndProc(var Message: TMessage);

begin

WindowProc(Message);

FreeDeviceContexts;

FreeMemoryContexts;

end;

FreeDeviceContexts; 和 FreeMemoryContexts 是保证VCL线程安全的，不在本文讨论之列，只看WindowProc(Message); 原来 MainWndProc 把消息委托给了方法 WindowProc处理，注意到 MainWndProc 不是虚拟方法，而 WindowProc 则是虚拟的，了解 Design Pattern 的朋友应该点头了，嗯，是个 Template Method ，很自然也很经典的用法，这样一来所有的消息都能准确到达目的地，也就是说从功能上看 MainWndProc 确实可以充作窗口函数。您现在可以回顾一下MFC的 AfxWindowProc 的做法，同样是利用对象的多态性，但是两种方式有所区别。

是不是有点乱了呢，让我们总结一下，VCL 注册窗口函数分三步：

1. [ TWinControl.Create ]

FObjectInstance 指向了 MainWndProc

2. [ TWinControl.CreateWnd ]

WindowClass.lpfnWndProc 值为 @InitWndProc;

调用Windows.RegisterClass(WindowClass)向系统注册

3. [ InitWndProc 初次被Callback时 ]

SetWindowLong(HWindow, GWL_WNDPROC, Longint(CreationControl.FObjectInstance))

窗口函数被偷梁换柱，从此 InitWndProc 退隐江湖

（注意是对每个TWinControl控件来说，InitWndProc 只被调用一次）

前面说过，非静态的类方法是不能注册成为窗口函数的，特别是Delphi中根本没有静态类方法，那么MainWndProc 也不能有特权（当然宝兰可以为此在编译器上动点手脚，如果他们不怕成为呕像的话）。

那么，那么，您应该意识到了，在幕后操纵一切的，正是......

背景打出字幕

超级巨星：麦克奥布吉特因斯坦斯

（MakeObjectInstance）

天空出现闪电，哦耶，主角才刚刚亮相。

废话不说，代码伺候：

（原始码在 Form.pas 中，“{}”中是原始的注释，而“ file://”/ 后的是我所加，您可以直接就注释代码，也可以先看我下面的评论，再回头啃code ）

// 共占 13 Bytes

type

PObjectInstance = ^TObjectInstance;

TObjectInstance = packed record

Code: Byte; // 1 Byte

Offset: Integer; // 4 Byte

case Integer of

0: (Next: PObjectInstance); // 4 Byte

1: (Method: TWndMethod); // 8 Byte

// TWndMethod 是一个指向对象方法的指针，

// 事实上是一个指针对，包含方法指针以

// 及一个对象的指针（即Self ）

end;

// 313是满足整个TInstanceBlock的大小不超过4096的最大值

InstanceCount = 313;

// 共占 4079 Bytes

type

PInstanceBlock = ^TInstanceBlock;

TInstanceBlock = packed record

Next: PInstanceBlock; // 4 Bytes

Code: array[1..2] of Byte; // 2 Bytes

WndProcPtr: Pointer; // 4 Bytes

Instances: array[0..InstanceCount] of TObjectInstance; 313 * 13 = 4069

end;

function CalcJmpOffset(Src, Dest: Pointer): Longint;

begin

Result := Longint(Dest) - (Longint(Src) + 5);

end;

function MakeObjectInstance(Method: TWndMethod): Pointer;

const

BlockCode: array[1..2] of Byte = (

$59, { POP ECX }

$E9); { JMP StdWndProc } // 实际上只有一个JMP

PageSize = 4096;

var

Block: PInstanceBlock;

Instance: PObjectInstance;

begin

// InstFreeList = nil 表明一个Instance block已被占满，于是需要为一个新

// Instance block分配空间，一个个Instance block通过PinstanceBlock中的

// Next 指针相连，形成一个链表，其头指针为InstBlockList

if InstFreeList = nil then

begin

// 为Instance block分配虚拟内存，并指定这块内存为可读写并可执行

// PageSize 为4096。

Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);

Block^.Next := InstBlockList;

Move(BlockCode, Block^.Code, SizeOf(BlockCode));

Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));

// 以下代码建立一个Instance的链表

Instance := @Block^.Instances;

repeat

Instance^.Code := $E8; { CALL NEAR PTR Offset }

file://算/出相对 jmp StdWndProc指令的偏移量，放在$E8的后面

Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);

Instance^.Next := InstFreeList;

InstFreeList := Instance;

// 必须有这步，让Instance指针移至当前instance子块的底部

Inc(Longint(Instance), SizeOf(TObjectInstance));

// 判断一个Instance block是否已被构造完毕

until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);

InstBlockList := Block;

end;

Result := InstFreeList;

Instance := InstFreeList;

InstFreeList := Instance^.Next;

Instance^.Method := Method;

end;

不要小看这区区几十行代码的能量，就是它们对 VCL 的可视组件进行了分页式管理，（代码中对两个链表进行操作，InstanceBlock 中有 ObjectInstance 的链表，而一个个InstanceBlock 又构成一个链表）一个 InstanceBlock 为一页，有4096 字节，虽然 InstanceBlock 实际使用的只有 4079 字节，不过为了 Alignment ,就加了些 padding 凑满 4096 。从代码可见每一页中可容纳 313 个所谓的ObjectInstance，如果望文生义很容易将这个 ObjectInstance 误解为对象实例，其实不然，每个ObjectInstance 其实是一小段可执行代码，而这些可执行代码不是编译期间生成的，也不是象虚拟函数那样滞后联编，而根本就是MakeObjectInstance 在运行期间“创作”的（天哪）! 也就是说，MakeObjectInstance 将所有的可视VCL组件改造成了一页页的可执行代码区域，是不是很了不起呢。

不明白ObjectInstance所对应的代码是做什么的么？没关系，一起来看

call - - - - - - - - - - - > pop ECX // 在call 之前，下一个指令地址会被压栈

@MainWndProc // 紧接着执行pop ECX, 为何这么做呢？

@Object(即Self) // 前面注释中提过

答案在 StdWndProc 的代码中，要命哦，全是汇编，可是无限风光在险峰，硬着头皮闯一回吧。

果不其然，我们发现其中用到了ECX

function StdWndProc(Window: HWND; Message, WParam: Longint;

LParam: Longint): Longint; stdcall; assembler;

asm

XOR EAX,EAX

PUSH EAX

PUSH LParam

PUSH WParam

PUSH Message

MOV EDX,ESP

MOV EAX,[ECX].Longint[4] // 相当于 MOV EAX, [ECX+4] ( [ECX+4] 是什么？就是Self )

CALL [ECX].Pointer // 相当于 CALL [ECX] , 也就是调用 MainWndProc

ADD ESP,12

POP EAX

end;

这段汇编中在调用MainWndProc前作了些参数传递的工作，由于MainWndProc 的定义如下

procedure TwinControl..MainWndProc(var Message: TMessage);

根据Delphi 的约定，这种情况下隐函数Self 作为第一个参数，放入EAX 中，TMessage 结构的指针作为第二个参数，放入EDX中，而Message的指针从哪儿来呢？我们看到在连续几个 Push 之后，程序已经在堆栈中构造了一个TMessage 结构，而这时的ESP 当然就是这个结构的指针，于是将它赋给EDX 。如果您不熟悉这方面的约定，可以参考Delphi 的帮助Object Pascal Refrence -> Program Control。

现在真相大白，Windows 消息百转千折终于传进MainWndProc , 不过这一路也可谓相当精彩，MakeObject这一函数自然是居功至伟， StdWndProc 也同样是幕后英雄，让我们把 MakeObjectInstance 作出的代码和StdWndProc 连接起来，哦，堪称鬼斧神工。
( 图片无法显示，请下载全文）

就此在总结一下， FobjectInstance 被VCL 注册为窗口函数，而实际上 FObjectInstance 并不实际指向某个函数，而是指向一个ObjectInstance, 而后者我们已经知道是一系列相接的可执行代码段当中的一块，当系统需要将 FObjectInstance 当做窗口函数作为回调时，实际进入了ObjectInstance 所在的代码段，然后几番跳跃腾挪（一个call 加一个 jump ）来到StdWndProc ，StdWndProc 的主要功用在于将Self 指针压栈，并把Windows的消息包装成Delphi的TMessage 结构，如此才能成功调用到TWinControl类的成员方法 MainWndProc, 消息一旦进入MainWndProc 便可以轻车熟路一路高唱小曲来到各个对象转属的WndProc , 从此功德圆满。

后记：

个人感觉在这一技术上VCL 要比MFC 效率高出不少，后者每次根据窗口句柄来检索相对应的窗口对象指针颇为费时，同时MakeObject 的代码也相当具有参考价值，有没有想过让你自己的程序在内存中再开一堆可执行代码？

所有的代码是基于Delphi5的，可能与其余版本有所出入，但相信不会很大。

整个星期六和星期天我都花在写作此文上了（连调试带写字），不过水平所限，难免有所错误与表达不周，但愿不至以己昏昏令人昏昏，欢迎来信探讨指教 cheka@yeah.net , thanx

发表于 2013-12-15 16:27 阿者阅读(276) 评论(0) 编辑收藏所属分类: windows

留言簿(2)

随笔分类

文章分类

文章档案

搜索

最新评论

VCL Delphi Windows消息窗口函数注册 MakeObject (转自网络)