Here is the declaration of IPersistStream.Save
:
function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
The key point is that the stream parameter is passed as const
. That means that the Save
function does not take a reference to the IStream
interface. Its reference count is neither incremented or decremented. And since neither happens, it is never destroyed.
The way to work around it is to make sure that something holds a reference to the interface. Which is what you demonstrate in the second example.
The reason that you need the assignment to nil
is down to the order in which this code is executed:
x := TStreamAdapter.Create(
TFileStream.Create('test.bin',fmOpenRead),soOwned
);
It happens in this order:
TFileStream.Create
.
TStreamAdapter.Create
.
x._Release
to clear the old reference.
- Take a reference to the new
IStream
.
And that is clearly in the wrong order. You need to clear x
before calling TFileStream.Create
.
According to former Embarcadero compiler engineer, Barry Kelly, the issue regarding the interface passed to a const parameter is a bug. It has never been fixed and I for one have given up hope of that ever happening.
My SSCCE to demonstrate the issue is here:
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.
Output
Instance1 created
Foo
Instance2 created
Instance2 _AddRef
Bar
Instance2 _Release
Instance2 destroyed