Delphi动态事件深入分析(转)

======================================================
注：本文源代码点此下载
======================================================

delphi动态事件深入分析

2009-2-7

作者:不得闲

核心提示:本实验证明了在类中方法的调用时候,所有的方法都隐含了一个self参数,并且该参数作为对象方法的第一个参数传递...

首先做一个空窗体,放入一button。

在implementation下面声明两个方法如下:

//外部方法,只声明一个参数,此时按照标准的对象内部事件方法tnotifyevent声明,此声明中,sender则对应为产生该事件的对象指针。

procedure extclick1(sender: tobject);

begin

{asm

mov eax,[edx+8]

call showmessage

end; }

showmessage(tcomponent(sender).name);

end;

//外部方法,声明两个参数,用来证明,对象在调用时候会传递一个self指针,此时我们假设frm是通过类对象传递过来的self指针,而sender为产生该事件的对象指针

procedure extclick(frm: tobject;sender: tobject);

begin

{asm

mov eax,[edx+8]

call showmessage

end; }

showmessage(tcomponent(sender).name);

if frm is tform then

tform(frm).close

end;

//然后在 ‘指定调用’按扭事件中写代码:

procedure tform1.button1click(sender: tobject);

begin

showmessage(tcomponent(sender).name);

end;

//很显然运行的时候,点该按扭得到的是返回一个 消息内容为 ‘button1’的对话框,这是调用form1类的对象事件触发的方法。

//在调用 ‘调用form类外部方法触发事件’ click事件中写

procedure tform1.button2click(sender: tobject);

var

extclickevent: tnotifyevent;

begin

integer(@extclickevent) := integer(@extclick1);

//将extclickevent地址指针指向外部函数extclick1方法的地址

button1.onclick := extclickevent;

//将该地址赋值给 button1的onclick事件替换以前的onclick事件

end;

//另一个按扭写代码如下:

procedure tform1.button3click(sender: tobject);

begin

button1.onclick := button1click;//还原为对象内触发事件函数

end;

运行之后

点一下 ‘调用form类外部方法触发事件’ ,然后在点 ‘指定调用’按扭,

showmessage(tcomponent(sender).name);返回的值是 ‘form1’,此时是否就已经说明了其第一个参数是否就是传递的一个self指针呢。所以在调用button.click事件的时候传递过来的第一个参数为form1内部的self指针,而该指针是指向form1的。此时,我们在该函数的

begin位置放下一个断点,程序运行时候,此处的断点为非可用的,如下图:

说明程序在begin处根本没有处理其他任何代码,此时,将断点调到

showmessage(tcomponent(sender).name);然后点 按扭 程序运行到断点处停下

调出cpu view窗口查看代码如下

注意 eax,ebx,edx,ecx的值,首先一条是

moveax,[eax+$08] //该条指令将对象的name属性值传递到eax中

callshowmessage //此函数需要一个参数,delphi的参数传递规则为eax,edx,ecx

如此可见,没有任何多余的处理,但是此时还不能证明eax传递过来的就是类对象的self指针

此时将 ‘调用form类外部方法触发事件’ click事件中代码的函数换成

extclick

既将integer(@extclickevent) := integer(@extclick1);

换成integer(@extclickevent) := integer(@extclick);

然后重新重复上面的步骤,在extclick的begin处下断点,程序运行到断点处停下,则说明

程序在begin时候有代码执行,打开cpu view查看如下:

可见在begin之后,showmessage函数之前,有两段代码如下:

push ebx//保存ebx的值

mov ebx,eax//将eax的值暂时存放到ebx中

然后主要看下面的showmessage(tcomponent(sender).name);一句

可见 其汇编代码如下:

moveax,[edx+$08]

callshowmessage

和以前相比 moveax,[eax+$08] 变成了 moveax,[edx+$08]

此时,然后运行,得到结果为tcomponent(sender).name 的值为button1

而下面的代码

if frm is tform then

tform(frm).close;

则充分证明了eax的值是 form1,则说明了对象方法在调用的时候会传递一个隐含的self指针,而该指针的值在eax中.

由于delphi中参数的传递为

eax第一个参数

edx第二个参数

ecx第三个参数

所以可知道,真正的触发事件的按扭对象存放在edx中.

所以我们可以得到如下结论

在 按扭的单击事件中,

tnotifyevent = procedure(sender: tobject) of object;

其真正的实体为procedure(当前声明引起的对象self,sender: tobject)

所以 button.onclick的时候,其实传递方式如下

button1.onclick(self,sender);

其他事件方法等,依次类推.

然后根据该结论,则我们可以不在受

为form中的某个控件对象指定事件方法的时候受到 of object 那个东西的限制,可以将事件方法指定到任何地方了。只要注意,该方法对应的参数要比其事件方法(of object)指定的方法多一个参数声明,则可

比如,此时,我们拿窗体关闭事件做文章:

新建一个按扭,写代码

procedure tform1.button4click(sender: tobject);

var

closeevent: tcloseevent;

begin

integer(@closeevent) := integer(@mycloseevent);

self.onclose := closeevent;

end;

窗体关闭的事件方法为

tcloseevent = procedure(sender: tobject;var action: tcloseaction) of object;

从上面结论我们知道可以声明一个外部函数,该外部函数的参数要比tcloseevent的参数多一个self指针的,所以我们声明如下:

procedure mycloseevent(frm: tform;sender: tobject;var action: tcloseaction);

frm则是外部在窗体关闭的时候,传递的隐含指针self

该函数整体代码如下:

procedure mycloseevent(frm: tform;sender: tobject;var action: tcloseaction);

begin

showmessage(frm.name+'窗体外部方法调用,不允许关闭窗体!');

action := canone;

end;

点一下,新建的按扭之后,看看是否还可以关闭窗体!!

通过汇编来处理

procedure tform1.setevent(event: pointer);

asm

push ebx//保护ebx

mov ebx,eax//将当前的eax的值,先用ebx保存起来,eax中保存的为form的开始地

mov eax,edx//将event指针的值给eax

mov [ebx+$2d8],eax//将eax的值分别写进其高位和低位

mov eax,[edx+4]

mov [ebx+$2d4],eax

pop ebx

end;

//由于前面我们已经证明了,在类之中的方法,其传递的时候,都会有一个隐含的参数self,所以,该段汇编代码中我们就知道了event参数对应应该是edx寄存器,而不是eax寄存器了。然后,后面有[ebx+$2d8]这样的内容,这个是窗体 onclose事件所在位置的地址。可以通过cpuview窗口查看得到,暂时没有想到如何通过指定一个 事件名称来得到该事件在内存中的地址。如果这样的话,那么则可以写一个函数

resetobjevent(eventname: string;eventvalue: pointer);

先通过eventname找到事件地址,然后再通过上面的则可以写出一个简单通俗易懂的公用函数了。

否则只能通过传递地址,根据改变地址中的值来修改事件函数的指向了。如下:

写一个专门用来重设置事件方法的函数如下:

procedure resetobjevent(oldeventaddress: pointer;neweventvalue: pointer);

var

gg: integer;

sd: pinteger;

begin

sd := oldevent;

gg := integer(newevent);

sd^:=gg;

end;

其实也就是 改变存放事件方法指针的内存块的数据值,使其变成另一个值。

注意,参数一指定为存放旧事件方法指针的内存地址,所以他应该是一个指针的指针了。

参数二指定为事件方法指针值。

调用方法如下:

比如,指定窗体的 onclose事件方法指针为窗体类外部定义的函数。

resetobjevent(@(integer(@form1.onclose)),@mycloseevent)

例如:

procedure frmclose(frm: tform;sender: tobject;var action: tcloseaction);

begin

showmessage('调用外部方法,不许关闭!');

action := canone;

end;

procedure tform1.bitbtn1click(sender: tobject);

begin

resetobjevent(@(integer(@self.onclose)),@frmclose);

end;

续言:

以上在delphi7下测试通过,至于2007下,我测试,也传递了一个隐含参数,但是该隐含参数不是self

再论:

经过cnpack的刘啸提醒之后,发现了delphi7下测试通过,而2007下不通过的原因是在于d7下如下声明:

procedure tform1.button4click(sender: tobject);

var

closeevent: tcloseevent;

begin

integer(@closeevent) := integer(@mycloseevent);

self.onclose := closeevent;

end;

此时2007下该段程序运行不能通过而d7编译运行可以通过,实在确实是一个巧合了。

通过提示得知,tcloseevent在delphi中被称为对象方法,而对象方法

在 delphi 中用 procedure(sender: tobject) of object; 这种格式声明的 事件(event) 类型实际上是同时包含有对象和函数的记录。我们可以把一个 tnotifyevent 的变量强制转换成 tmethod:

tmethod = record

code, data: pointer;

end;

例如我们声明了一个方法 mainform.btnclick 并将它赋值给 btn1.onclick 事件,实际上是将 mainform 对象和 btnclick 方法地址分别作为 tmethod 结构的 data 和 code 成员赋值给 btn1.onclick 事件属性。当 btn1 按钮调用这个 btnclick 事件时,实际上是将 tmethod 结构的 data 作为第一个参数去调用 code 函数。

我们可以编写下面的代码:

procedure myclick(self: tobject; sender: tobject);

begin

// 第一个参数是虚拟的

showmessage(format('self: %d, sender: %s', [integer(self), sender.classname]));

end;

procedure tform1.formcreate(sender: tobject);

var

m: tmethod;

begin

m.code := @myclick;

m.data := pointer(325); // 随便取的数

btn1.onclick := tnotifyevent(m);

end;

这样就可以将一个普通函数赋值给对象事件属性了。

我们再来看看 tlanguages.create 的代码:

constructor tlanguages.create;

type

tcallbackthunk = packed record

popedx: byte;

moveax: byte;

selfptr: pointer;

pusheax: byte;

pushedx: byte;

jmp: byte;

jmpoffset: integer;

end;

var

callback: tcallbackthunk;

begin

inherited create;

callback.popedx := $5a;

callback.moveax := $b8;

callback.selfptr := self;

callback.pusheax := $50;

callback.pushedx := $52;

callback.jmp:= $e9;

callback.jmpoffset := integer(@tlanguages.localescallback) - integer(@callback.jmp) - 5;

enumsystemlocales(tfnlocaleenumproc(@callback), lcid_supported);

end;

在 win32 sdk 中可以查到 enumsystemlocales 要求的回调格式是:

bool callback enumlocalesproc(

lptstr lplocalestring// pointer to locale identifier string

);

而 sysutils 中的方法声明:

tlanguages = class

...

function localescallback(localeid: pchar): integer; stdcall;

...

end;

显然,我们是无法将 localescallback 这个方法直接传递给 enumsystemlocales 的,因为 localescallback 的函数形式声明实际上是:

function localescallback(self: tlanguages; localeid: pchar): integer; stdcall;

比 enumlocalesproc 多出来一个参数。

所以在 tlanguages.create 中,使用了 callback 结构变量来生成一小段动态代码。这段代码是构造在堆栈中的(局部变量),转换成汇编是:

prcoedure callbackthunk;

asm

// 取出 lplocalestring 参数到 edx 寄存器

// callback enumlocalesproc 是 stdcall 调用,参数在堆栈中

pop edx

// 将 self 对象传给 eax 寄存器

mov eax self

// stdcall 调用,将 self 作为第一个参数压栈

push eax

// 将 lplocalestring 作为第二个参数压栈

push edx

// 用相对跳转指令跳转到 tlanguages.localescallback 入口地址

jmp tlanguages.localescallback

end;

将 callbackthunk 作为临时的回调函数传递给 enumsystemlocales 是合法的。当回调被执行时,前面那小段代码动态修改了堆栈的内容,将本来只有一个参数的调用,变成了两个参数,从而实现了回调与对象方法的转换。

但是,正如 passion 在前面提到的,由于这小块临时代码是放在堆栈中的,而 win2003 的 dep 限制了在堆栈中执行代码,导致事实上回调函数并没有被正确地调用。

borland 程序员也看到了这个问题,所以在 bds 2006 中,这部分代码的实现修改成:

var

ftemplanguages: tlanguages;

function enumlocalescallback(localeid: pchar): integer; stdcall;

begin

result := ftemplanguages.localescallback(localeid);

end;

constructor tlanguages.create;

begin

inherited create;

ftemplanguages := self;

enumsystemlocales(@enumlocalescallback, lcid_supported);

end;

通过声明一个临时变量和转换函数,来取代原来的方法,就不会有 dep 冲突了。

附带说一下 forms 单元中的 makeobjectinstance。这个函数用来生成一块动态代码,将 windows 的窗体消息处理过程转换为 delphi 的对象方法调用。在 twincontrol 等需要有消息处理支持的地方用到。该函数也是采用了前面类似的方法,不过不同的是,由于这些转换调用是长期的,所以那些动态生成的代码被放到了标识为可执行的动态空间中了,所以在 win2003 的 dep 下仍然可以正常工作:

function makeobjectinstance(method: twndmethod): pointer;

var

...

begin

if instfreelist = nil then

begin

block := virtualalloc(nil, pagesize, mem_commit, page_execute_readwrite);

...

end;

刘啸

例如我们声明了一个方法 mainform.btnclick 并将它赋值给 btn1.onclick 事件,实际上是将 mainform 对象和 btnclick 方法地址分别作为 tmethod 结构的 data 和 code 成员赋值给 btn1.onclick 事件属性。“当 btn1 按钮调用这个 btnclick 事件时,实际上是将 tmethod 结构的 data 作为第一个参数去调用 code 函数。”

这里关于调用的似乎值得讨论一下。记得这个事件onclick在被调用时是这么写的:

if assigned(fonclick) then

fonclick(self);

第一个参数是调用时传入的是button自身,也就是button的self,而不是原本这个method里头的data吧?

我的理解是,method的data只是用来说明这个方法属于哪个对象实例,但被调的时候似乎没发挥作用。所以自行捏造一个tmethod的data部分,然后给onclick等赋值再调用也能成功。

周劲羽

if assigned(fonclick) then

fonclick(self);

这里传入的 self 是 tnotifyevent 中的 sender: tobject 参数,而作为对象方法的 onclick,实际上需要两个参数,第一个隐藏的 self 是 onclick 方法所从属的对象,第二个才是 sender。

比如 button 调用 fonclick 时,这个 fonclick 指向的方法可能是从属于某个 form 的 onbtnclick。类自己是不保存对象实例的,直接调用 form.onbtnclick 时 self 是 form 这个实例,而通过 button.fonclick 调用到 form.onbtnclick 方法时,onbtnclick 的 self 从哪里来?当然就是用 tmethod.data 传过去的喽。而这个 tmethod.data 则是在赋值 button.onclick := form.onbtnclick 时的 form 对象。

fonclick时传入的self是作为sender的,而btnonclick方法里头所引用的self是form实例,后者的self应该是从data里头来的。

由上可得到一个通用函数,用来动态设置对象事件:

procedure resetobjevent(oldeventaddr: pointer;neweventvalue: pointer;resetobject: tobject);

begin

tmethod(oldeventaddr^).code := neweventvalue;

tmethod(oldeventaddr^).data := resetobject;

end;

参数一: 指定为 存放事件指针的内存地址值的地址指针,所以为一个指针的指针

参数二: 指定为新的事件函数地址指针

参数三: 指定为重设事件的修改者,用来隐射对象方法的隐含参数self

调用方法:

resetobjevent(@integer(@self.onclose),@mycloseevent,self);

例:

procedure mycloseevent(classsend: tobject;sender: tobject;var action: tcloseaction );

begin

action := canone;

showmessage(tcomponent(sender).name+'触发,不许关闭');

showmessage(tcomponent(classsend).name);

end;

procedure tform1.button1click(sender: tobject);

begin

resetobjevent(@integer(@self.onclose),@mycloseevent,self);

end;

======================================================
在最后，我邀请大家参加新浪APP，就是新浪免费送大家的一个空间，支持PHP+MySql，免费二级域名，免费域名绑定 这个是我邀请的地址，您通过这个链接注册即为我的好友，并获赠云豆500个，价值5元哦！短网址是http://t.cn/SXOiLh我创建的小站每天访客已经达到2000+了，每天挂广告赚50+元哦，呵呵，饭钱不愁了，\(^o^)/