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

【问题标题】：How can I dynamically inject code into event handlers in Delphi?如何在 Delphi 中将代码动态注入事件处理程序？
【发布时间】：2011-01-27 08:28:55
【问题描述】：

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

例如，对于数据模块中的所有数据集，我需要在 BeforeOpen 和 AfterOpen 事件中运行代码以捕获开始时间，并在 AfterOpen 中记录经过的时间。

我更喜欢动态地执行此操作（无组件子类化），以便仅在需要时才可以轻松地将其添加到所有现有数据模块和表单中。

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

所以这段代码

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

在运行时会变成

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

  SomeProc;
end;

是否有可以应用的设计模式，或者甚至是一些示例代码来展示如何在 Delphi 中实现这一点？

【问题讨论】：

你没有提到你正在使用什么 DBMS。但作为一种完全不同的方法，您是否考虑过使用 DB Profiler？例如。使用 SQL Server 探查器，您有很大的灵活性，并且能够查看 BeforeOpen/AfterOpen 未涵盖的内部详细信息。

标签： delphi event-handling aop

【解决方案1】：

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

我在我的开源 Delphi 分析器中使用了 detouring： http://code.google.com/p/asmprofiler/
（在我的一般配置文件功能中，我使用程序集来保存堆栈、cpu 寄存器等，以便它可以配置/挂钩任何功能）。

但是如果你想要一个更“智能”的方式（比如关于 beforeopen 和 afteropen 的知识）你必须做一些额外的工作：你需要为 TDataset 后代等创建一个特殊的处理类。

【讨论】：

【解决方案2】：

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

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 中，您可以在调用原始事件处理程序之前、之后或前后引入您的代码。

用OwnsObjects := true 收集TObjectList 中的包装器对象，当您清除或释放对象列表时，一切都将恢复到原始状态。

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

【讨论】：

我刚刚看到 LukLed 也有类似的想法。
@Uwe Raabe：+1 描述得很好。我一直使用此解决方案以 1-1 关系同步数据集中的插入/编辑/发布。一次调用 Insert/Edit/Post 会在第二次触发 Insert/Edit/Post。效果很好。
优点：您不需要名称模糊的单位刻度。缺点：更具侵入性：即使使用单独的类，您也需要将代码添加到项目中以挂钩事件。
@Ritsaert：附加代码只需要 dpr 中的一行，类似于 AddDataSetLoggers([DataModule1, DataModule2, ...]);
@Jeroen：我知道，但是 OP 声明：“对于已经分配了事件处理程序的组件，我需要一种方法来存储现有的事件处理程序，并分配一个新的修改过的事件处理程序，它首先进行日志记录，然后将调用已经存在的原始代码。”我的代码就是这样做的。

【解决方案3】：

我会试试这个：

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;

将一个 TDataSetBeforeOpenStartTimeStorer 实例附加到每个 TDataSet，您将拥有自己的功能。

【讨论】：

【解决方案4】：

如果您要“挂钩”的组件中的函数或过程被声明为虚拟或动态，则可以通过以下方式完成：

让我们假设您想查看 TDataset 中的所有 AfterOpen。此事件处理程序是从虚拟方法调用的：

procedure TDataSet.DoAfterOpen;

创建一个新单元UnitDatasetTester（手动输入）

unit UnitDatasetTester;

interface

uses
  DB;

type
  TDataset = class( DB.TDataset )
  protected
    procedure DoAfterOpen; override;
  end;

implementation

uses
  MySpecialLoggingUnit; 

procedure TDataset.DoAfterOpen;
begin
  inherited;
  SpecialLog.Add( 'Hello world' );
end;

如果你不使用这个单元，所有的作品都不需要 loggi。如果您将此单元用作使用列表中的最后一个单元（至少在数据库使用之后），您确实拥有该单元中所有数据集的日志记录。

【讨论】：

另一种方法是复制数据库单元并将副本添加到您的项目目录中（确保它在您的项目中）。现在编辑这个 db.pas 文件来添加你想要的日志。创建第二个项目，不使用这个单元和一个不同的项目目录，但使用第一个项目中的所有其他单元。
不错的提示，但我会将日志记录设为有条件的（在构建模式、编译开关或变量上）并始终使用此单元构建项目。按需添加和删除单元（并将它们放在正确的空间）太容易出错。
@mghie：您可以通过将使用包装在条件中来做到这一点。但这不是问题的一部分。不过可能会提到它。
不错的技巧，但如果应用于 TDataSet 则不太可能按预期工作。例如。当您创建 TTable 时，它已经从 DB.TDataSet 继承（除非您更改 DBTables 单元）。 TDataSet 的任何子类本身都可以覆盖这些方法。所以 TDataSet 的本地化覆盖不会启动。但是，将相同的技术应用于您希望实例化的每个具体子类应该可以完美地工作。

【解决方案5】：

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

对于 TDataSet：

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

从头开始，这是几天的工作。但是，您可以从我的会议“使用数据库和数据感知控件的更智能代码”的示例代码开始。
链接见我的Conferences, seminars and other public appearances page wiert.wordpress.com。

--杰罗恩

【讨论】：