Delphi动态事件深入分析

首先做一个窗体如下  
然后单元中如下代码：
在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的值,首先一条是  
Mov  eax,[eax+$08] //该条指令将对象的Name属性值传递到Eax中  
Call   ShowMessage //此函数需要一个参数，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);一句  
可见 其汇编代码如下：  
Mov  eax,[edx+$08]  
Call  ShowMessage  
和以前相比 Mov  eax,[eax+$08] 变成了 Mov  eax,[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;