How to combine two methods with the same structure using RTTI?

[bravesofts 28]

I’m working on a class TMethodsInjector that uses RTTI to inject a method into a method-type property (like events). If a method is already assigned, I want to combine it with the new one (same signature) and assign the result.

The key part is here:

if not Assigned(LOldMethod.Code) then
  LCombined := LNewMethod
else
  LCombined := GenerateCombinedMethod(LRttiProperty, LOldMethod, LNewMethod);

I need help implementing GenerateCombinedMethod — it should dynamically wrap both LOldMethod and LNewMethod (same structure) into a single TMethod that invokes both in order.
Is there a clean way to do this using RTTI, without knowing the method signature in advance?

my full class code is:
 

unit API.Methods.Injector;

interface

uses
  System.Classes,
  System.SysUtils,
  System.Rtti,
  System.TypInfo;

type
  TMethodsInjector = class
  public
    class procedure InjectMethod(aTarget: TObject; const aPropertyName: string;
      aMethodAddress: Pointer; aMethodData: TObject); static;
  end;

implementation

{ TMethodsInjector }

class procedure TMethodsInjector.InjectMethod(aTarget: TObject; const aPropertyName: string;
  aMethodAddress: Pointer; aMethodData: TObject);
var
  LRttiContext: TRttiContext;
  LRttiType: TRttiType;
  LRttiProperty: TRttiProperty;
  LOldMethod, LNewMethod, LCombined: TMethod;
begin
  if not Assigned(aTarget) then
    Exit;

  LRttiContext := TRttiContext.Create;
  try
    LRttiType := LRttiContext.GetType(aTarget.ClassType);
    LRttiProperty := LRttiType.GetProperty(aPropertyName);

    if Assigned(LRttiProperty) and (LRttiProperty.PropertyType.TypeKind = tkMethod) then
    begin
      LOldMethod := GetMethodProp(aTarget, aPropertyName);

      LNewMethod.Code := aMethodAddress;
      LNewMethod.Data := aMethodData;

      if not Assigned(LOldMethod.Code) then
        LCombined := LNewMethod
      else
        LCombined := GenerateCombinedMethod(LRttiProperty, LOldMethod, LNewMethod);

      SetMethodProp(aTarget, aPropertyName, LCombined);

    end
    else
      raise Exception.CreateFmt('Property %s not found or is not a method on %s',
        [aPropertyName, aTarget.ClassName]);
  finally
    LRttiContext.Free;
  end;
end;

end.

 

[bravesofts 28]

i succeed to have this:

  TMethodsInjector = class
  private
    class var
      fM1, fM2: TMethod;

    class procedure InvokeCombined;
    class function CombineMethods(const M1, M2: TMethod): TMethod; static;
  public
    class procedure InjectPropertyMethod(aTarget: TObject; const aPropertyName: string;
      aMethodAddress: Pointer; aMethodData: TObject; aOverrideOldIfAssigned: Boolean = False); static;
  end;

implementation

{ TMethodsInjector }

class procedure TMethodsInjector.InvokeCombined;
type
  TProcOfObject = procedure of object;
begin
  if Assigned(fM1.Code) then TProcOfObject(fM1)();
  if Assigned(fM2.Code) then TProcOfObject(fM2)();
end;

class function TMethodsInjector.CombineMethods(const M1, M2: TMethod): TMethod;
begin
  fM1 := M1;
  fM2 := M2;

  TMethod(Result).Code := @InvokeCombined;
  TMethod(Result).Data := fM1.Data;
end;

class procedure TMethodsInjector.InjectPropertyMethod(aTarget: TObject; const aPropertyName: string;
  aMethodAddress: Pointer; aMethodData: TObject; aOverrideOldIfAssigned: Boolean);
var
  LRttiContext: TRttiContext;
  LRttiType: TRttiType;
  LRttiProperty: TRttiProperty;
  LOldMethod, LNewMethod, LCombined: TMethod;
begin
  if not Assigned(aTarget) then
    Exit;

  LRttiContext := TRttiContext.Create;
  try
    LRttiType := LRttiContext.GetType(aTarget.ClassType);
    LRttiProperty := LRttiType.GetProperty(aPropertyName);

    if Assigned(LRttiProperty) and (LRttiProperty.PropertyType.TypeKind = tkMethod) then
    begin
      LOldMethod := GetMethodProp(aTarget, aPropertyName);

      LNewMethod.Code := aMethodAddress;
      LNewMethod.Data := aMethodData;

      LCombined := LNewMethod; // Case old is nil or (assigned and must override)

      if Assigned(LOldMethod.Code) and not aOverrideOldIfAssigned then
        LCombined := CombineMethods(LOldMethod, LNewMethod);

      SetMethodProp(aTarget, aPropertyName, LCombined);

    end
    else
      raise Exception.CreateFmt('Property %s not found or is not a method on %s',
        [aPropertyName, aTarget.ClassName]);
  finally
    LRttiContext.Free;
  end;
end;

end.

the code works perfectly, but in case of mousedown i got AccessViolation error when i release my mouse from the dragging form,

here is the code:

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    procedure InternalOnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure InjectClickToButton(AButton: TButton; aWithOverride: Boolean = False);
  public
    { Public declarations }
  end;

implementation

uses
  API.Methods.Injector;

{$R *.dfm}

procedure GlobalOnClickHandler(Sender: TObject);
begin
  ShowMessage('Injected Click!');
end;

procedure TMainView.InjectClickToButton(AButton: TButton; aWithOverride: Boolean);
begin
  TMethodsInjector.InjectPropertyMethod(
    AButton,
    'OnClick',
    @GlobalOnClickHandler,
    Self,  // or Self if inside a class
    aWithOverride
  );
end;

procedure TMainView.BtnInjectWithoutOverrideClick(Sender: TObject);
begin
  InjectClickToButton(BtnTarget);
end;

procedure TMainView.BtnInjectWithOverrideClick(Sender: TObject);
begin
  InjectClickToButton(BtnTarget, True);
end;

procedure TMainView.BtnTargetClick(Sender: TObject);
begin
  ShowMessage('Hi from Default');
end;

procedure TMainView.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
end;

procedure TMainView.InternalOnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TMainView.BtnIjectFormDragClick(Sender: TObject);
begin
  TMethodsInjector.InjectPropertyMethod(
    Self,
    'OnMouseDown',
    @TMainView.InternalOnMouseDown,
    Self
  );
end;

end.

 

Edited 7 hours ago by bravesofts
remove unecessary overload

[Der schöne Günther 336]

Can you show an example, how you would typically make use of it?

[bravesofts 28]

2 hours ago, Der schöne Günther said:

Can you show an example, how you would typically make use of it?

Yes, here’s a practical use case:

Example: Suppose I have a legacy application with over 100 forms, and I need to log every time a form is shown. Instead of modifying each form manually or forcing them to inherit from a new base class, I use TMethodsInjector to dynamically inject a logging procedure into the OnShow event of each form at runtime — all without changing the existing form code.

This approach is especially useful in scenarios where inheritance or code edits aren't feasible — such as working with third-party components, plugin-based modules, or dynamically loaded forms.

That said, this class is still in a beta/concept stage and hasn’t been fully battle-tested in real-world production scenarios. If you have a more robust or elegant way to achieve this kind of dynamic behavior injection without modifying the original source, I’d be genuinely glad to hear and learn from it!

[Anders Melander 1973]

8 hours ago, bravesofts said:

Is there a clean way to do this using RTTI, without knowing the method signature in advance?

No.

 

You have no way of knowing what the caller has put on the stack (or in the registers), what the called method does with it, what it returns and how.

You can probably make it work for very simple delegate types (TNotifyEvent for example) but I think it would be better to find a less fragile solution.