TVirtualMethodInterceptorを試す。

と思ったのに

たった1日でdocwikiから消されとるがなｗｗｗｗｗ
まあせっかく調べたし書こう…。

そもそもTVirtualMethodInterceptorって何よ

動作検証をしたところ、仮想メソッドの呼び出しをフックし、呼び出し前と呼び出し後にイベントを発生させることのできるクラスの模様。
…がしかし、上記のように無かったことにされてるし、そもそも個別のページもTObjectの説明がコピペされてるだけで一切の説明がないので本当のところが何なのかはよく分かんない。
あとTwitterで「VirtualMethodInterceptorのことじゃね？」と教えていただいたんだけど、大凡の用途は同じながら中身はほぼ別物っぽい。

そんなことよりまず使ってみようぜ磯野

program Project1;

{$APPTYPE CONSOLE}

uses Rtti;

type
  TInterceptedClass = class
  public
    function Concat(const Arg1, Arg2, Arg3: string): string; virtual;
  end;

function TInterceptedClass.Concat(const Arg1, Arg2, Arg3: string): string;
begin
  Result := Arg1 + ' ' + Arg2 + ' ' + Arg3;
end;

procedure TestProc;
var
  targetObj, normalObj: TInterceptedClass;
  interceptor: TVirtualMethodInterceptor;
begin
  interceptor := TVirtualMethodInterceptor.Create(TInterceptedClass);
  targetObj := TInterceptedClass.Create;
  normalObj := TInterceptedClass.Create;
  interceptor.OnBefore :=
    procedure(Instance: TObject; Method: TRttiMethod; const Args: TArray<Rtti.TValue>;
              out DoInvoke: Boolean; out Result: TValue)
    begin
      DoInvoke := False;
      Result := 'わはー';
    end;
  Writeln(targetObj.Concat('Hello', 'World', '!')); // A
  interceptor.Proxify(targetObj);
  Writeln(targetObj.Concat('Hello', 'World', '!')); // B
  Writeln(normalObj.Concat('Hello', 'World', '!')); // C

  targetObj.Free;
  normalObj.Free;
  interceptor.Free;
end;

begin
  TestProc;
end.

結果

Hello World ! // A
わはー // B
Hello World ! // C

解説

TVirtualMethodInterceptorのコンストラクタにはインターセプト対象のクラス参照を渡し、そのインスタンスのOnBefore（やOnAfterやOnException）に実行する内容を無名メソッドで記述する。
AはまだProxify前なので、渡した引数を連結した正しい結果が返ってくるけど、Proxify後のBでは結果がOnBeforeで指定したものに置き換えられていてインターセプトが成功している。CはProxifyを適用していないnormalObjなのでAと同じく正しい結果が得られ、このことからフックは全体ではなくProxifyをしたインスタンスのみに影響することが分かる。
ちなみにOnBeforeのDoInvokeにFalseを代入しておくと、本来のメソッドは呼び出されなくなる。本来のメソッドを呼び出した上で戻り値を書き換えたい場合はOnAfterのResultを書き換える。

しくみ

Proxify前後で上記のConcatのメソッドアドレスを調べてみると異なっているので、（当たり前と言えば当たり前だけど）VMTの書き換えによって実現しているみたい*1。

ちなみに

昨日試した時点ではインターセプトされたクラスを解放すると何故かEPrivilege例外が発生していたんだけど、これはどうやらTVirtualMethodInterceptorのインスタンスを解放してもVMTが元のものには書き換えられず、結果として存在しないフックメソッドをコールしてしまっていたためみたい。
つまりインターセプターは対象オブジェクトの生存期間中はずっと存在しなくてはならないということになる*2。

// ダメなパターン
obj := TInterceptedClass.Create;
interceptor := TVirtualMethodInterceptor.Create(TInterceptedClass);
interceptor.Proxify(obj);
interceptor.Free;
obj.Free; // Destroyが仮想メソッドなのでフックされているが、すでに解放済みなので＼(^o^)／オワタ

// 大丈夫なパターン
obj := TInterceptedClass.Create;
interceptor := TVirtualMethodInterceptor.Create(TInterceptedClass);
interceptor.Proxify(obj);
obj.Free; // Destroyはフックされてるけどinterceptorが生きてるからちゃんと動くよ！
interceptor.Free;

よく考えたら分かったこと

これ呼び出し規約やらを考え出したらちょっと面倒ではあるけど、XEで実装されたコンパイラマジックを使ってるというわけでもなさそうだし、Delphi2010でも頑張れば実装できるんじゃね？

*1:正確に言えばVMTそのものではなくVMTを指すポインタの書き換え

*2:インターセプトを解除するメソッド等は存在しない

Swanman's Horizon

性欲をもてあましつつなんらかの話をするよ。