如何在Delphi中将代码动态注入事件处理程序？

Question

对于调试/性能测试,我想在运行时动态地将日志代码添加到给定类型的组件的所有事件处理程序.

例如,对于Datamodule中的所有数据集,我需要在BeforeOpen和AfterOpen事件中运行代码以捕获开始时间,并在AfterOpen中记录已用时间.

我更喜欢动态地执行此操作(没有组件子类化),因此我可以在需要时以最小的努力将其添加到所有现有的数据模块和表单中.

迭代所有组件并按类型过滤很容易,但是对于已经分配了事件处理程序的组件,我需要一种方法来存储现有的事件处理程序,并分配一个新的修改后的事件处理程序,它首先执行日志记录,然后调用原始代码已经存在.

所以这段代码

procedure TMyDatamodule.OnBeforeOpen(Sender: TDataset);
begin
  SomeProc;
end;

在运行时会变成

procedure TMyDatamodule.OnBeforeOpen(Sender: TDataset);
begin
  StoreStartTime(Sender); // injected code

  SomeProc;
end;

是否有可以应用的设计模式,甚至是一些示例代码,说明如何在Delphi中实现它？

Answer 1

您可以使用以下方案重新连接数据集:

type
  TDataSetEventWrapper = class
  private
    FDataSet: TDataSet;
    FOrgAfterOpen: TDataSetNotifyEvent;
    FOrgBeforeOpen: TDataSetNotifyEvent;
    procedure MyAfterOpen(DataSet: TDataSet);
    procedure MyBeforeOpen(DataSet: TDataSet);
  protected
    property DataSet: TDataSet read FDataSet;
  public
    constructor Create(ADataSet: TDataSet);
    destructor Destroy; override;
  end;

constructor TDataSetEventWrapper.Create(ADataSet: TDataSet);
begin
  Assert(ADataSet <> nil);
  inherited Create;
  FDataSet := ADataSet;
  FOrgAfterOpen := FDataSet.AfterOpen;
  FOrgBeforeOpen := FDataSet.BeforeOpen;
  FDataSet.AfterOpen := MyAfterOpen;
  FDataSet.BeforeOpen := MyBeforeOpen;
end;

destructor TDataSetEventWrapper.Destroy;
begin
  FDataSet.AfterOpen := FOrgAfterOpen;
  FDataSet.BeforeOpen := FOrgBeforeOpen;
  inherited;
end;

procedure TDataSetEventWrapper.MyBeforeOpen(DataSet: TDataSet);
begin
  if Assigned(FOrgBeforeOpen) then
    FOrgBeforeOpen(DataSet);
end;

procedure TDataSetEventWrapper.MyAfterOpen(DataSet: TDataSet);
begin
  if Assigned(FOrgAfterOpen) then
    FOrgAfterOpen(DataSet);
end;

在内部MyAfterOpen,MyBeforeOpen您可以在调用原始事件处理程序之前,之后或周围引入代码.

在TObjectListwith中收集包装器对象,OwnsObjects := true当您清除或释放对象列表时,所有内容都将恢复为原始对象.

警告:要使此代码生效,必须在创建包装器时连接事件,并禁止手动重新分配这些事件.