开发者

How to mix Interfaces and Classes by avoiding _Release to be called?

开发者 https://www.devze.com 2023-04-02 11:40 出处:网络
When using Interfaces in Delphi and overriding reference counting, it is possible to bypass the_Release calls Delphi makes when an interface reaches a reference count of zero.

When using Interfaces in Delphi and overriding reference counting, it is possible to bypass the_Release calls Delphi makes when an interface reaches a reference count of zero.

But - when mixing classes and interfaces (which is very useful) the _Release method is ALWAYS called no matter what. The problem is that in the sample code below, the local object is nill-ed, but _Release is still called - excep开发者_JAVA技巧t on invalid memory. Depending on memory operations in the application, an exception can result when _Release is called on the nilled localObject's old location or no exception if the memory was not re-used.

So, can the compiler generated call to _Release be "removed/blocked/avoided/killed/redirected/vmt hijacked/terminated/smacked/etc etc etc"? If this can be achieved you have proper pure interfaces in Delphi.

unit TestInterfaces;

interface

uses
  Classes,
  SysUtils;

type

  ITestInterface = interface
    ['{92D4D6E4-A67F-4DB4-96A9-9E1C40825F9C}']
    procedure Run;
  end;

  TTestClass = class(TInterfacedObject, ITestInterface)
  protected
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    procedure Run;
  end;

  TRunTestClass = class(TObject)
  protected
    FlocalInterface : ITestInterface;
    FlocalObject : TTestClass;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Test;
  end;

  procedure RunTest;
  procedure RunTestOnClass;

var
  globalInterface : ITestInterface;

implementation


procedure RunTest;
var
  localInterface : ITestInterface;
  localObject : TTestClass;
begin

  try

    //create an object
    localObject := TTestClass.Create;

    //local scope
    // causes _Release call when object is nilled
    localInterface := localObject;
    localInterface.Run;

    //or global scope
    // causes _Release call when exe shuts down - possibly on invalid memory location
    globalInterface := localObject;
    globalInterface.Run;

  finally
    //localInterface := nil; //--> forces _Release to be called
    FreeAndNil( localObject );
  end;

end;

procedure RunTestOnClass;
var
  FRunTestClass : TRunTestClass;
begin
  FRunTestClass := TRunTestClass.Create;
  FRunTestClass.Test;
  FRunTestClass.Free;
end;


{ TTheClass }

procedure TTestClass.Run;
begin
  beep;
end;

function TTestClass._AddRef: Integer;
begin
  result := -1;
end;

function TTestClass._Release: integer;
begin
  result := -1;
end;

{ TRunTestClass }

constructor TRunTestClass.Create;
begin
  FlocalObject := TTestClass.Create;
  FlocalInterface := FlocalObject;
end;

destructor TRunTestClass.Destroy;
begin
  //..
  FlocalObject.Free;
  //FlocalObject := nil;
  inherited;
end;

procedure TRunTestClass.Test;
begin
  FlocalInterface.Run;
end;

end.


There's no practical way to achieve what you are looking for. The compiler is going to emit the calls to _Release and in order to whack them you would need to find all the call sites. That's not practical.

I'm afraid the only viable approach when reference counted lifetime management is disabled is to ensure that you finalize (i.e. set to nil) all your interface references before calling Free.


When you use Interfaces you do not need to free your objects any more. interfaced objects will released automatically when there is no any references to same object.

In your sample you must delete _Release and _Addref functions in TTestClass they are defined in TInterfacedObject class.

In RunTest procedure you not need to Free the localObject only in finally section set globalInterface to nil. after end of procedure localInterface will destroy the local object automatically.

try
  ... use your code
  ...
finnaly
  globalInnterface := nil;
end;

And about TTestRun.Destroy just left this destructor blank. you must not Free the FlocalObject.

TTestRun.Destroy;
begin
  inherited;
end;
0

精彩评论

暂无评论...
验证码 换一张
取 消