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

对于调试/性能测试，我希望在运行时向给定类型的组件的所有事件处理程序动态添加日志代码

例如，对于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中实现这一点？

没有通用的方法可以做到这一点，除非达到非常低的级别。
基本上，您可以按照Delphi调试器的思路编写一些东西

对于TDataSet：

我将创建一个新的TDataSource并将其指向TDataSet实例。然后我将使用创建一个数据感知组件，并使用TDataLink捕获您感兴趣的内容

从零开始，这是几天的工作。但是，您可以从我的会议会话“具有数据库和数据感知控件的智能代码”的示例代码入手。
请参阅我的链接

---

--jeroen

如果要“钩住”的组件中的功能或过程是declard虚拟或动态的，可以通过以下方式完成：

为了便于讨论，我们假设您希望查看TDataset中的所有AfterOpen。从虚拟方法调用此事件处理程序：

procedure TDataSet.DoAfterOpen;

创建一个新的UnitDataSetter（在手册中键入）

如果您不使用此装置，则所有装置均无需loggig。如果将此单元用作“使用”列表中的最后一个单元（至少在DB使用之后），则该单元中的所有数据集都有日志记录。

我会尝试以下方法：

TDataSetBeforeOpenStartTimeStorer = class(TObject)

constructor Create(MyDataModule : TMyDatamodule);
begin
    OldBeforeOpen := MyDatamodule.OnBeforeOpen;
    MyDatamodule.OnBeforeOpen = NewBeforeOpen;
end;

procedure NewBeforeOpen(Sender: TDataset);
begin
  StoreStartTime(Sender);
  if Assigned(OldBeforeOpen) then
    OldBeforeOpen(Sender);
end;

---

将一个TDataSetBeforeStartTimeStorer实例连接到每个TDataSet，您将拥有您的功能。

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

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;

类型
TDataSetEventWrapper=class
私有的
FDataSet:TDataSet；
forgfafteropen:TDataSetNotifyEvent；
FOrgBeforeOpen:TDataSetNotifyEvent；
程序MyAfterOpen（数据集：TDataSet）；
过程MyBeforeOpen（数据集：TDataSet）；
受保护的
属性数据集：TDataSet读取FDataSet；
公众的
构造函数创建（ADataSet:TDataSet）；
毁灭者毁灭；推翻
结束；
构造函数TDataSetEventWrapper.Create（ADataSet:TDataSet）；
开始
断言（ADataSet-nil）；
继承创造；
FDataSet:=ADataSet；
FOrgAfterOpen:=FDataSet.AfterOpen；
FOrgBeforeOpen:=FDataSet.BeforeOpen；
FDataSet.AfterOpen:=MyAfterOpen；
FDataSet.BeforeOpen:=MyBeforeOpen；
结束；
析构函数TDataSetEventWrapper.Destroy；
开始
FDataSet.AfterOpen:=forgfafteropen；
FDataSet.BeforeOpen:=FOrgBeforeOpen；
继承；
结束；
过程TDataSetEventWrapper.MyBeforeOpen（数据集：TDataSet）；
开始
如果指定（在打开之前放弃），则
FOrgBeforeOpen（数据集）；
结束；
过程TDataSetEventWrapper.MyAfterOpen（数据集：TDataSet）；
开始
如果已分配（打开），则
开放（数据集）；
结束；

在

MyAfterOpen

和

MyBeforeOpen

中，您可以在调用原始事件处理程序之前、之后或前后引入代码

使用

OwnsObjects:=true

在

TObjectList

中收集包装器对象，当您清除或释放objectlist时，所有内容都将恢复到原始状态

---

注意：要使此代码正常工作，必须在创建包装器时连接事件，并且禁止手动重新分配这些事件。

如果您想以通用（且“快速简便”）方式执行，可以使用迂回和RTTI （RTTI：搜索已发布的事件属性；迂回：钩住原始函数并将其重新路由/迂回到您自己的函数）

我在开源Delphi profiler中使用detouring：
（在我的通用配置文件函数中，我使用assembly保留堆栈、cpu寄存器等，以便它可以配置/挂接任何函数）

---

但是，如果您想要一种更“智能”的方式（如了解beforeopen和afteropen），您必须做一些额外的工作：您需要为TDataset子体等创建一个特殊的处理类。

另一种方法是复制db单元，并将副本添加到项目目录中（确保它在项目中）。现在编辑此db.pas文件以添加所需的日志记录。创建没有使用此单元的第二个项目，使用不同的项目目录，但使用第一个项目中的所有其他单元。提示不错，但我会设置日志记录条件（在构建模式、编译开关或变量上），并始终使用此单元构建项目。按需添加和删除单元（并将它们放在正确的空间）太容易出错。@mghie：您可以通过在条件中包装使用来实现这一点。但这不是问题的一部分。可能已经提到了。这是一个很好的技巧，但如果应用到TDataSet，则不太可能像预期的那样工作。例如，当您创建TTable时，它已经从DB.TDataSet继承（除非您更改DBTables单元）。TDataSet的任何子类本身都可以重写这些方法。因此TDataSet的局部覆盖不会生效。但是，将相同的技术应用到您希望实例化的每个具体子类应该可以很好地工作。我刚刚看到LukLed有一个类似的想法。@Uwe Raabe:+1以获得良好的描述。我一直使用此解决方案将插入/编辑/发布数据集与1-1 relati同步

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;