Advertisement
sglienke

Non virtual Method interception

Jul 15th, 2015
326
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Project1;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   DDetours,
  7.   Generics.Collections,
  8.   Rtti,
  9.   SysUtils,
  10.   TypInfo;
  11.  
  12. type
  13.   TFoo = class
  14.     procedure Bar;
  15.   end;
  16.  
  17. { TFoo }
  18.  
  19. procedure TFoo.Bar;
  20. begin
  21.   Writeln('TFoo.Bar');
  22. end;
  23.  
  24. type
  25.   TDispatchKinds = set of TDispatchKind;
  26.   TMemberVisibilities = set of TMemberVisibility;
  27.   TMethodInterceptor = class
  28.   private class var
  29.     fContext: TRttiContext;
  30.     type
  31.       PMethodIntercept = ^TMethodIntercept;
  32.       TMethodIntercept = record
  33.         Method: TRttiMethod;
  34.         Impl: TMethodImplementation;
  35.         Intercept: Pointer;
  36.       end;
  37.   private
  38.     fInterceptors: TArray<TMethodIntercept>;
  39.     fInterceptedInstances: TList<TObject>;
  40.     procedure HandleIntercept(intercept: Pointer; const args: TArray<TValue>;
  41.       out result: TValue);
  42.   public
  43.     constructor Create(classType: TClass;
  44.       visibilities: TMemberVisibilities = [mvPublic..mvPublished];
  45.       dispatchKinds: TDispatchKinds = [dkStatic]);
  46.     destructor Destroy; override;
  47.  
  48.     procedure Proxify(const instance: TObject);
  49.     procedure Unproxify(const instance: TObject);
  50.   end;
  51.  
  52. { TMethodInterceptor }
  53.  
  54. constructor TMethodInterceptor.Create(classType: TClass;
  55.   visibilities: TMemberVisibilities;
  56.   dispatchKinds: TDispatchKinds);
  57. var
  58.   method: TRttiMethod;
  59.   methods: TArray<TRttiMethod>;
  60.   i: Integer;
  61. begin
  62.   inherited Create;
  63.   fInterceptedInstances := TList<TObject>.Create;
  64.   methods := fContext.GetType(classType).GetMethods;
  65.   SetLength(fInterceptors, Length(methods));
  66.   for i := 0 to High(methods) do
  67.   begin
  68.     method := methods[i];
  69.     if method.Parent.AsInstance.MetaclassType = TObject then
  70.       Continue;
  71.     if not (method.DispatchKind in dispatchKinds) then
  72.       Continue;
  73.     if not (method.Visibility in visibilities) then
  74.       Continue;
  75.     fInterceptors[i].Method := method;
  76.     fInterceptors[i].Impl := method.CreateImplementation(@fInterceptors[i], HandleIntercept);
  77.     fInterceptors[i].Intercept :=
  78.       InterceptCreate(method.CodeAddress, fInterceptors[i].Impl.CodeAddress);
  79.   end;
  80. end;
  81.  
  82. destructor TMethodInterceptor.Destroy;
  83. var
  84.   i: Integer;
  85. begin
  86.   for i := 0 to High(fInterceptors) do
  87.   begin
  88.     if fInterceptors[i].Method <> nil then
  89.     begin
  90.       fInterceptors[i].Impl.Free;
  91.       InterceptRemove(fInterceptors[i].Intercept);
  92.     end;
  93.   end;
  94.   fInterceptedInstances.Free;
  95.   inherited;
  96. end;
  97.  
  98. procedure TMethodInterceptor.HandleIntercept(intercept: Pointer;
  99.   const args: TArray<TValue>; out result: TValue);
  100. var
  101.   method: TRttiMethod;
  102. begin
  103.   method := PMethodIntercept(intercept).Method;
  104.   if fInterceptedInstances.Contains(args[0].AsObject) then
  105.     Writeln('intercepted: ', method.ToString);
  106.   if method.ReturnType <> nil then
  107.     Invoke(PMethodIntercept(intercept).Intercept, args,
  108.       method.CallingConvention, method.ReturnType.Handle)
  109.   else
  110.     Invoke(PMethodIntercept(intercept).Intercept, args,
  111.       method.CallingConvention, nil);
  112. end;
  113.  
  114. procedure TMethodInterceptor.Proxify(const instance: TObject);
  115. begin
  116.   if not fInterceptedInstances.Contains(instance) then
  117.     fInterceptedInstances.Add(instance);
  118. end;
  119.  
  120. procedure TMethodInterceptor.Unproxify(const instance: TObject);
  121. begin
  122.   fInterceptedInstances.Remove(instance);
  123. end;
  124.  
  125. procedure Main;
  126. var
  127.   f: TFoo;
  128.   i: TMethodInterceptor;
  129. begin
  130.   f := TFoo.Create;
  131.   try
  132.     i := TMethodInterceptor.Create(TFoo);
  133.     try
  134.       f.Bar;
  135.       i.Proxify(f);
  136.       f.Bar;
  137.     finally
  138.       i.Free;
  139.     end;
  140.   finally
  141.     f.Free;
  142.   end;
  143. end;
  144.  
  145. begin
  146.   ReportMemoryLeaksOnShutdown := True;
  147.   try
  148.     Main;
  149.   except
  150.     on E: Exception do
  151.       Writeln(E.ClassName, ': ', E.Message);
  152.   end;
  153.   Readln;
  154. end.
Advertisement
RAW Paste Data Copied
Advertisement