Why is this TStreamAdapter not released?

Question

Compare these two snippets:

(d as IPersistStream).Save(
  TStreamAdapter.Create(
    TFileStream.Create('test.bin',fmCreate),soOwned),true);
(d as IPersistStream).Load(
  TStreamAdapter.Create(
    TFileStream.Create('test.bin',fmOpenRead),soOwned));

This is not performed in the second TFileStream.Create, because the first is not destroyed. This is strange, since the parameter has a single link, I thought that it would be destroyed when the call was closed Save. So I tried this:

var
  x:IStream;
begin
  x:=TStreamAdapter.Create(
    TFileStream.Create('test.bin',fmCreate),soOwned);
  (d as IPersistStream).Save(x,true);
  x:=nil;
  x:=TStreamAdapter.Create(
    TFileStream.Create('test.bin',fmOpenRead),soOwned);
  (d as IPersistStream).Load(x);
  x:=nil;

Which works great. (But again not executed without x:=nil;). Therefore don't worry about dhea IPersistStreamand behaves correctly. Why _Releasedoes a forced call require an explicit assignment nil? Is this a problem with Delphi 7? Is it because of the linker / compiler switch?

Answer 1

IPersistStream.Save:

function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;

, const. , Save IStream. . , .

, , - . , .

, nil, :

x := TStreamAdapter.Create(
  TFileStream.Create('test.bin',fmOpenRead),soOwned
);

:

• TFileStream.Create.
• TStreamAdapter.Create.
• x._Release, .
• IStream.

. TFileStream.Create x.

---

- Embarcadero , , const, . , .

SSCCE :

program SO22846335;

{$APPTYPE CONSOLE}

type
  TMyInterfaceObject = class(TObject, IInterface)
    FRefCount: Integer;
    FName: string;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    constructor Create(const Name: string);
    destructor Destroy; override;
  end;

constructor TMyInterfaceObject.Create(const Name: string);
begin
  inherited Create;
  FName := Name;
  Writeln(FName + ' created');
end;

destructor TMyInterfaceObject.Destroy;
begin
  Writeln(FName + ' destroyed');
  inherited;
end;

function TMyInterfaceObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result := E_NOINTERFACE;
end;

function TMyInterfaceObject._AddRef: Integer;
begin
  Writeln(FName + ' _AddRef');
  Result := AtomicIncrement(FRefCount);
end;

function TMyInterfaceObject._Release: Integer;
begin
  Writeln(FName + ' _Release');
  Result := AtomicDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

procedure Foo(const Intf: IInterface);
begin
  Writeln('Foo');
end;

procedure Bar(Intf: IInterface);
begin
  Writeln('Bar');
end;

begin
  Foo(TMyInterfaceObject.Create('Instance1'));
  Bar(TMyInterfaceObject.Create('Instance2'));
  Readln;
end.

Instance1 created
Foo
Instance2 created
Instance2 _AddRef
Bar
Instance2 _Release
Instance2 destroyed