Problem mit automatischem freigeben von Interfaces

[himitsu]

Aber nur doch wenn man schon eine Interface-Referenz hat, welche man da übergeben kann.
Wenn erst soeine Instanz erstellt werden muß, dann sollte diese auch mit gezählt werden, da sie vor der Übergabe lokl in einer temporären Variable zwischengespeichert wird.


[edit]
Das überrascht mich jetzt aber, da ist wirklich kein AddRef

Delphi-Quellcode:

type
  ITest = interface
    ['{CB192645-8A70-4AB5-8EDD-ADD0304EDC27}']
  end;

  TTest = class(TObject, ITest)
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    class procedure Test1(const Intf: ITest);
    class procedure Test2(Intf: ITest);
  end;

function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  ShowMessage('QueryInterface' + GUIDToString(IID));
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TTest._AddRef: Integer;
begin
  Inc(FRefCount);
  ShowMessage('_AddRef ' + IntToStr(FRefCount));
end;

function TTest._Release: Integer;
begin
  Dec(FRefCount);
  ShowMessage('_Release ' + IntToStr(FRefCount));
end;

class procedure TTest.Test1(const Intf: ITest);
begin
  if Assigned(Intf) then ;
  ShowMessage('call Test1');
end;

class procedure TTest.Test2(Intf: ITest);
begin
  if Assigned(Intf) then ;
  ShowMessage('call Test2');
end;

procedure TForm11.Button2Click(Sender: TObject);
var
  T: TTest;
  I: ITest;
begin
  ShowMessage('create-o');
  T := TTest.Create;
  ShowMessage('Test1-o');
  TTest.Test1(T);
  ShowMessage('Test2-o');
  TTest.Test2(T);

  ShowMessage('I:=');
  I := T;
  ShowMessage('Test1-i');
  TTest.Test1(I);
  ShowMessage('Test2-i');
  TTest.Test2(I);
  ShowMessage('nil');
  I := nil;

  ShowMessage('Free');
  T.Free;

  ShowMessage('create-i');
  I := TTest.Create;
  ShowMessage('nil');
  I := nil;

  ShowMessage('End');
end;