MakeObjectInstance函数是Delphi函数Q这个函数的x部分是这L(fng)Q?br />function MakeObjectInstance(Method: TWndMethod): Pointer;
和它相对应的另一个函数叫做FreeObjectInstanceQ它的申明部分是q样的：
procedure FreeObjectInstance(ObjectInstance: Pointer);
MakeObjectInstance函数在Delphi的帮助文件中q没有，但是它还是在Interface中申明了Q?br />也就是说我们可以使用它?br />
要完全解释清楚这个函数的作用不是三言两语的事情，
现脓(chung)上一文章：
关键?
VCL Delphi Windows消息 H口函数 注册 MakeObject 汇编 贴文旉
2001-7-9 17:16:31 文章cd:
原作 l脓(chung)子投?
投票
cheka 原作 出处:
VCL HardCore ——VCLH口函数注册机制研究手记Q兼与MFC比较
By cheka cheka@yeah.net Q{载请保留此信息）
q个名字L(fng)有些思h听闻Q无他意Q只为吸引眼球而已Q如果?zhn)对下列关键词有兴，希望不要错过本文Q?br />
1. VCL可视lg在内存中的分式理;
2. 让系l回调类的成员方?br />
3. Delphi 中汇~指令的使用
4. Hardcore
5. W?条是骗你?br />
我们知道Windowsq_上的GUIE序都必遵循Windows的消息响应机Ӟ可以单概括如下，所有的H口控g都向pȝ注册自n的窗口函敎ͼq行期间消息可被指派至特定窗口控件的H口函数处理。对消息相应机制做这L(fng)概括有失严密Q请各位见谅Q我惌紧{向本文重点，卛_利用Object Pascali或是C++q样的面向对象语a~程中，如何把一个类的成员方法向pȝ注册以供回调?
在注册窗口类卌用RegisterClass函数Ӟ我们向系l传递的是一个WindowProc cd的函数指?br />
WindowProc 的定义如?br />
LRESULT CALLBACK WindowProc(
HWND hwnd, // handle to window
UINT uMsg, // message identifier
WPARAM wParam, // first message parameter
LPARAM lParam // second message parameter
)Q?br />
如果我们有一个控件类Q它拥有看似h相同定义的成员方法TMyControl.WindowProc,可是却不能够它的首地址作ؓlpfnWndProc参数传给RegisterClassQ道理很单，因ؓDelphi中所有类成员Ҏ(gu)都有一个隐含的参数Q也是SelfQ因此无法符合标?WindowProc 的定义?br />
那么Q在VCL中，控g向系l注册时I竟传递了一个什么样的窗口指针，同时通过q个指针又是如何调到各个cȝ事g响应Ҏ(gu)呢？我先卖个兛_Q先看看MFC是怎么做的?br />
在调查MFC代码之前Q我作过两种猜想Q?br />
一Q作注册用的函数指针指向的是一个类的静态方法，
静态方法同样不需要隐含参?this Q对?Delphi中的 Self ,不过Object Pascal不支持静态方法）
二，作注册用的函数指针指向的是一个全局函数Q这当然最传统Q没什么好说的?br />
l过单的跟踪Q我发现MFC中，全局函数AfxWndProc是整个MFCE序处理消息?#8220;根节?#8221;Q也是_所有的消息都由它指z不同控g的消息响应函敎ͼ也就是说Q所有的H口控g向系l注册的H口函数很可能就?AfxWndProc Q抱歉没做深入研IӞ如果不对h正）。而AfxWndProc 是如何调用各个窗口类的WndProc呢？
哈哈QMFC用了一U很朴素的机Ӟ相比它那么多E奇古怪的宏来_q种机制相当好理解：使用一个全局的Map数据l构来维护所有的H口对象和Handle(其中Handle为键|Q然后AfxWndProcҎ(gu)Handle来找出唯一对应的窗口对象（使用静态函数CWnd::FromHandlePermanent(HWND hWnd) Q，然后调用其WndProcQ注意WndProc可是虚拟Ҏ(gu)Q因此消息能够正到达所指定H口cȝ消息响应函数q被处理?br />
于是我们有理q想VCL也可能采用相同的机制Q毕竟这U方式实现v来很单。我实是这么猜的，不过l论是我错了......
开场秀l束Q好戏正式上演?br />
在Form1上放一个Button(~省名ؓButton1),在其OnClick事g中写些代码，加上断点QF9q行Q当停留在断点上Ӟ打开Call StackH口QView->Debug Window->Call StackQ?或者按Ctrl-Alt-S )可看到调用顺序如下（从底往上看Qstack嘛）
( 如果你看到的 Stack 和这个不一_h开DCU 调试开?Project->Options->Compiler->Use Debug DCUs, q个开兛_果不打开Q是没法调试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 的角Ԍ不过我们先不谈它Q如果你抑制不住好奇心，可以提前ȝ它的源码Q在Forms.pas中，看到了么? 是不是特~~~~别有阿?br />
实际上，VCL在RegisterClass时传递的H口函数指针q指向StdWndProc。那是什么呢Q?br />
我跟Q我跟，我跟跟跟Q终于在Controls.pas的TWindowControl的实C码中
Qprocedure TWinControl.CreateWnd;) 看到了RegisterClass的调?hohoQ终于找到组l了......别忙Q发C没，q时候注册的H口函数是InitWndProcQ看看它的定义，嗯，W合标准Q再ȝ瞧代码都q了些什么?br />
发现q句Q?br />
SetWindowLong(HWindow, GWL_WNDPROC,Longint(CreationControl.FObjectInstance));
我FaintQ搞了半天InitWndProc初次被调用（Ҏ(gu)一个Wincontrol来说Q就把自个儿l换了，C岗的是FObjectInstance。下面还有一段汇编Q是紧接着调用FObjectInstance的，调用的理׃奇怪，因ؓ以后调用FObjectInstace都由pȝCallBack了，但现在还得劳InitWndProc的大驑֎call。调用的方式有些讲究Q不q留l?zhn)看完q篇文章后自个儿琢磨d?br />
接下来只能l看FObjectInstance是什么东东，它定义在 TWinControl ?Private D，是个Pointer也就是个普通指针，当什么都行Q你跟Windows说它?yu)?WndProc 型指?Windows 拿你也没辙?br />
FObjectInstanceI竟指向何处呢，镜头Ud TWincontrol 的构造函敎ͼq是FObjectInstance初次被赋值的地方?多余的代码不用看Q焦Ҏ(gu)在这句上
FObjectInstance := MakeObjectInstance(MainWndProc);
可以先告诉?zhn)QMakeObjectInstance是本主题最_ֽ之处Q但是?zhn)现在只需知道FObjectInstance“指向?#8221;MainWndProcQ也是说通过某种途径VCL把每个MainWndProc作ؓH口函数注册了，先证明容易的Q即 MainWndProc 具备H口函数的功能，来看代码Q?br />
( 省去异常处理 )
procedure TWinControl.MainWndProc(var Message: TMessage);
begin
WindowProc(Message);
FreeDeviceContexts;
FreeMemoryContexts;
end;
FreeDeviceContexts; ?FreeMemoryContexts 是保证VCLU程安全的，不在本文讨论之列Q只看WindowProc(Message); 原来 MainWndProc 把消息委托给了方?WindowProc处理Q注意到 MainWndProc 不是虚拟Ҏ(gu)Q?WindowProc 则是虚拟的，了解 Design Pattern 的朋友应该点头了Q嗯Q是?Template Method Q?很自然也很经典的用法Q这样一来所有的消息都能准确到达目的圎ͼ也就是说从功能上?MainWndProc 实可以充作H口函数。?zhn)现在可以回顾一下MFC?AfxWindowProc 的做法，同样是利用对象的多态性，但是两种方式有所区别?
是不是有点ؕ了呢Q让我们ȝ一下，VCL 注册H口函数分三步：
1. [ TWinControl.Create ]
FObjectInstance 指向?MainWndProc
2. [ TWinControl.CreateWnd ]
WindowClass.lpfnWndProc gؓ @InitWndProc;
调用Windows.RegisterClass(WindowClass)向系l注?br />
3. [ InitWndProc 初次被Callback?]
SetWindowLong(HWindow, GWL_WNDPROC, Longint(CreationControl.FObjectInstance))
H口函数被偷梁换柱，从此 InitWndProc 退隐江?br />
Q注意是Ҏ(gu)个TWinControl控g来说QInitWndProc 只被调用一ơ）
前面说过Q非静态的cL法是不能注册成ؓH口函数的，特别是Delphi中根本没有静态类Ҏ(gu)Q那么MainWndProc 也不能有Ҏ(gu)Q当然宝兰可以ؓ此在~译器上动点手脚Q如果他们不怕成为呕像的话）?
那么Q那么，(zhn)应该意识到了，在幕后操U一切的Q正?.....
背景打出字幕
巨星Q麦克奥布吉特因斯坦?
QMakeObjectInstanceQ?
天空出现闪电(sh)Q哦Ӟ主角才刚刚亮相?
废话不说Q代码伺候：
Q?原始码在 Form.pas 中，“{}”中是原始的注释，?#8220; file://”/ 后的是我所加，(zhn)可以直接就注释代码Q也可以先看我下面的评论Q再回头啃code Q?
// 共占 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 是一个指向对象方法的指针Q?br />
// 事实上是一个指针对Q包含方法指针以
// 及一个对象的指针Q即Self Q?br />
end;
// 313是满x个TInstanceBlock的大不过4096的最大?br />
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已被占满Q于是需要ؓ一个新
// Instance block分配I间Q一个个Instance block通过PinstanceBlock中的
// Next 指针相连QŞ成一个链表，其头指针为InstBlockList
if InstFreeList = nil then
begin
// 为Instance block分配虚拟内存Qƈ指定q块内存为可dq可执行
// PageSize ?096?br />
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的链?br />
Instance := @Block^.Instances;
repeat
Instance^.Code := $E8; { CALL NEAR PTR Offset }
file://?出相?jmp StdWndProc指o的偏U量Q放?E8的后?br />
Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
Instance^.Next := InstFreeList;
InstFreeList := Instance;
// 必须有这步，让Instance指针U至当前instance子块的底?br />
Inc(Longint(Instance), SizeOf(TObjectInstance));
// 判断一个Instance block是否已被构造完?br />
until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
InstBlockList := Block;
end;
Result := InstFreeList;
Instance := InstFreeList;
InstFreeList := Instance^.Next;
Instance^.Method := Method;
end;
不要看q区区几十行代码的能量，是它们?VCL 的可视组件进行了分页式管理，Q代码中对两个链表进行操作，InstanceBlock 中有 ObjectInstance 的链表，而一个个InstanceBlock 又构成一个链?Q一?InstanceBlock Z，?096 字节Q虽?InstanceBlock 实际使用的只?4079 字节Q不qؓ?Alignment ,加了些 padding 凑满 4096 。从代码可见每一中可容U?313 个所谓的ObjectInstanceQ如果望文生义很Ҏ(gu)这?ObjectInstance 误解为对象实例，其实不然Q每个ObjectInstance 其实是一段可执行代码，而这些可执行代码不是~译期间生成的，也不是象虚拟函数那样滞后联编Q而根本就是MakeObjectInstance 在运行期?#8220;创作”的（天哪Q? 也就是说QMakeObjectInstance 所有的可视VCLlg 攚w成了一页的可执行代码区域Q是不是很了不v呢?
不明白ObjectInstance所对应的代码是做什么的么？没关p，一h?
call - - - - - - - - - - - > pop ECX // 在call 之前Q下一个指令地址会被压栈
@MainWndProc // 紧接着执行pop ECX, Zq么做呢Q?br />
@Object(即Self) // 前面注释中提q?
{案?StdWndProc 的代码中Q要命哦Q全是汇~，可是无限风光在险峎ͼ着头皮闯一回吧?
果不其然Q我们发现其中用CECX
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;
q段汇编中在调用MainWndProc前作了些参数传递的工作Q由于MainWndProc 的定义如?br />
procedure TwinControl..MainWndProc(var Message: TMessage);
Ҏ(gu)Delphi 的约定，q种情况下隐函数Self 作ؓW一个参敎ͼ攑օEAX 中，TMessage l构的指针作为第二个参数Q放入EDX中，而Message的指针从哪儿来呢Q我们看到在q箋几个 Push 之后Q程序已l在堆栈中构造了一个TMessage l构Q而这时的ESP 当然是q个l构的指针，于是它赋给EDX 。如果?zhn)不熟?zhn)这斚w的约定，可以参考Delphi 的帮助Object Pascal Refrence -> Program Control?
现在真相大白QW(xu)indows 消息百{千折l于传进MainWndProc , 不过q一路也可谓相当_ֽQMakeObjectq一函数自然是居功至伟， StdWndProc 也同hq后英雄Q让我们?MakeObjectInstance 作出的代码和StdWndProc q接hQ哦Q堪U鬼斧神工?br />( 囄无法昄Q请下蝲全文Q?br />
此在ȝ一下， FobjectInstance 被VCL 注册为窗口函敎ͼ而实际上 FObjectInstance q不实际指向某个函数Q而是指向一个ObjectInstance, 而后者我们已l知道是一pd相接的可执行代码D当中的一块，当系l需要将 FObjectInstance 当做H口函数作ؓ回调Ӟ实际q入了ObjectInstance 所在的代码D，然后几番跌腾挪Q一个call 加一?jump Q来到StdWndProc QStdWndProc 的主要功用在于将Self 指针压栈Qƈ把Windows的消息包装成Delphi的TMessage l构Q如此才能成功调用到TWinControlcȝ成员Ҏ(gu) MainWndProc, 消息一旦进入MainWndProc 便可以轻车熟路一路高唱小曲来到各个对象{属的WndProc , 从此功d圆满?
后记Q?
个h感觉在这一技术上VCL 要比MFC 效率高出不少Q后者每ơ根据窗口句柄来索相对应的窗口对象指针颇Ӟ同时MakeObject 的代码也相当h参考h(hun)|有没有想q让你自qE序在内存中再开一堆可执行代码Q?
所有的代码是基于Delphi5的，可能与其余版本有所出入Q但怿不会很大?
整个星期六和星期天我都花在写作此文上了（q调试带写字Q， 不过水^所限，隑օ有所错误与表达不周，但愿不至以己昏昏令h昏昏Q欢q来信探讨指?cheka@yeah.net , thanx
VCL Delphi Windows消息 H口函数 注册 MakeObject (转自|络)
]]>