Delphi: How delegate interface implementation to c

问题:

i have an object which delegates implementation of a particularly complex interface to a child object. This is exactly i think is the job of TAggregatedObject. The "child" object maintains a weak reference to its "controller", and all QueryInterface requests are passed back to the parent. This maintains the rule that IUnknown is always the same object.

So, my parent (i.e. "Controller") object declares that it implements the IStream interface:

type
   TRobot = class(TInterfacedObject, IStream)
   private
      function GetStream: IStream;
   public
      property Stream: IStream read GetStrem implements IStream;
   end;

Note: This is a hypothetical example. i chose the word Robot because it sounds complicated, and and word is only 5 letters long - it's short. i also chose IStream because its short. i was going to use IPersistFile or IPersistFileInit, but they're longer, and make the example code harder to real. In other words: It's a hypothetical example.

Now i have my child object that will implement IStream:

type
   TRobotStream = class(TAggregatedObject, IStream)
   public
      ...
   end;

All that's left, and this is where my problem starts: creating the RobotStream when it's asked for:

function TRobot.GetStream: IStream;
begin
    Result := TRobotStream.Create(Self) as IStream;
end;

This code fails to compile, with the error Operator not applicable to this operand type..

This is because delphi is trying to perform the as IStream on an object that doesn't implement IUnknown:

TAggregatedObject = class
 ...
   { IUnknown }
   function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;
 ...

The IUnknown methods may be there, but the object doesn't advertise that it supports IUnknown. Without an IUnknown interface, Delphi can't call QueryInterface to perform the cast.

So i change my TRobotStream class to advertise that it implements the missing interface (which it does; it inherits it from its ancestor):

type
   TRobotStream = class(TAggregatedObject, IUnknown, IStream)
   ...

And now it compiles, but crashes at runtime on the line:

Result := TRobotStream.Create(Self) as IStream;

Now i can see what's happening, but i can't explain why. Delphi is calling IntfClear, on my parent Robot object, on the way out of the child object's constructor.

i don't know the proper way to prevent this. i could try forcing the cast:

Result := TRobotStream.Create(Self as IUnknown) as IStream;

and hope that keeps a reference. Turns out that it does keep the reference - no crash on the way out of the constructor.

Note: This is confusing to me. Since i am passing an object where an interface is expected. i would assume that the compiler is implicitly preforming a typecast, i.e.:

Result := TRobotStream.Create(Self as IUnknown);

in order to satisfy the call. The fact that the syntax checker didn't complain let me to assume all was correct.

---

But the crashes aren't over. i've changed the line to:

Result := TRobotStream.Create(Self as IUnknown) as IStream;

And the code does indeed return from the constructor of TRobotStream without destroying my parent object, but now i get a stack overflow.

The reason is that TAggregatedObject defers all QueryInterface (i.e. type casts) back to the parent object. In my case i am casting a TRobotStream to an IStream.

When i ask the TRobotStream for its IStream at the end of:

Result := TRobotStream.Create(Self as IUnknown) as IStream;

It turns around and asks its controller for the IStream interface, which triggers a call to:

Result := TRobotStream.Create(Self as IUnknown) as IStream;
   Result := TRobotStream.Create(Self as IUnknown) as IStream;

which turns around and calls:

Result := TRobotStream.Create(Self as IUnknown) as IStream;
   Result := TRobotStream.Create(Self as IUnknown) as IStream;
      Result := TRobotStream.Create(Self as IUnknown) as IStream;

Boom! Stack overflow.

---

Blindly, i try removing the final cast to IStream, let Delphi try to implicitely cast the object to an interface (which i just saw above doesn't work right):

Result := TRobotStream.Create(Self as IUnknown);

And now there is no crash; which i don't understand this very much. i've constructed an object, an object which supports multiple interfaces. How is it now that Delphi knows to cast the interface? Is it performing the proper reference counting? i saw above that it doesn't. Is there a subtle bug waiting to crash for the customer?

So i'm left with four possible ways to call my one line. Which one of them is valid?

1. Result := TRobotStream.Create(Self);
2. Result := TRobotStream.Create(Self as IUnknown);
3. Result := TRobotStream.Create(Self) as IStream;
4. Result := TRobotStream.Create(Self as IUnknown) as IStream;

The Real Question

i hit quite a few subtle bugs, and difficult to understand intricacies of the compiler. This leads me to believe that i have done everything completely wrong. If needed, ignore everything i said, and help me answer the question:

What is the proper way to delegate interface implementation to a child object?

Maybe i should be using TContainedObject instead of TAggregatedObject. Maybe the two work in tandem, where the parent should be TAggregatedObject and the child is TContainedObject. Maybe it's the other way around. Maybe neither apply in this case.

Note: Everything in the main part of my post can be ignored. It was just to show that i have thought about it. There are those who would argue that by including what i have tried, i have poisoned the possible answers; rather than answering my question, people might focus on my failed question.

The real goal is to delegate interface implementation to a child object. This question contains my detailed attempts at solving the problem with TAggregatedObject. You don't even see my other two solution patterns. One of which suffers from circular refernce counts, and the breaks the IUnknown equivalence rule.

Rob Kennedy might remember; and asked me to make a question that asks for a solution to the problem, rather than a solution to a problem in one of my solutions.

Edit: grammerified

Edit 2: No such thing as a robot controller. Well, there is - i worked with Funuc RJ2 controllers all the time. But not in this example!

Edit 3*

  TRobotStream = class(TAggregatedObject, IStream)
    public
        { IStream }
     function Seek(dlibMove: Largeint; dwOrigin: Longint;
        out libNewPosition: Largeint): HResult; stdcall;
     function SetSize(libNewSize: Largeint): HResult; stdcall;
     function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint; out cbWritten: Largeint): HResult; stdcall;
     function Commit(grfCommitFlags: Longint): HResult; stdcall;
     function Revert: HResult; stdcall;
     function LockRegion(libOffset: Largeint; cb: Largeint; dwLockType: Longint): HResult; stdcall;
     function UnlockRegion(libOffset: Largeint; cb: Largeint; dwLockType: Longint): HResult; stdcall;
     function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult; stdcall;
     function Clone(out stm: IStream): HResult; stdcall;

     function Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult; stdcall;
     function Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult; stdcall;
  end;

  TRobot = class(TInterfacedObject, IStream)
  private
      FStream: TRobotStream;
      function GetStream: IStream;
  public
     destructor Destroy; override;
      property Stream: IStream read GetStream implements IStream;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
    rs: IStream;
begin
    rs := TRobot.Create;
    LoadRobotFromDatabase(rs); //dummy method, just to demonstrate we use the stream
    rs := nil;
end;

procedure TForm1.LoadRobotFromDatabase(rs: IStream);
begin
    rs.Revert; //dummy method call, just to prove we can call it
end;

destructor TRobot.Destroy;
begin
  FStream.Free;
  inherited;
end;

function TRobot.GetStream: IStream;
begin
  if FStream = nil then
     FStream := TRobotStream.Create(Self);
  result := FStream;
end;

Problem here is that the "parent" TRobot object is destroyed during the call to:

FStream := TRobotStream.Create(Self);

回答1:

You have to add a field instance for the created child object:

type
  TRobot = class(TInterfacedObject, IStream)
  private
     FStream: TRobotStream;
     function GetStream: IStream;
  public
     property Stream: IStream read GetStream implements IStream;
  end;

destructor TRobot.Destroy;
begin
  FStream.Free; 
  inherited; 
end;

function TRobot.GetStream: IStream;
begin
  if FStream = nil then 
    FStream := TRobotStream.Create(Self);
  result := FStream;
end;

Update TRobotStream should be derived from TAggregatedObject as you already guessed. The declaration should be:

type
  TRobotStream = class(TAggregatedObject, IStream)
   ...
  end;

It is not necessary to mention IUnknown.

In TRobot.GetStream the line result := FStream does an implicite FStream as IStream so writing this out isn't necessary either.

FStream has to be declared as TRobotStream and not as IStream so it can be destroyed when the TRobot instance is destroyed. Note: TAggregatedObject has no reference counting so the container has to take care of its lifetime.

Update (Delphi 5 code):

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, activex, comobj;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    procedure LoadRobotFromDatabase(rs: IStream);
  public
  end;

type
  TRobotStream = class(TAggregatedObject, IStream)
  public
    { IStream }
    function Seek(dlibMove: Largeint; dwOrigin: Longint;
       out libNewPosition: Largeint): HResult; stdcall;
    function SetSize(libNewSize: Largeint): HResult; stdcall;
    function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint; out cbWritten: Largeint): HResult; stdcall;
    function Commit(grfCommitFlags: Longint): HResult; stdcall;
    function Revert: HResult; stdcall;
    function LockRegion(libOffset: Largeint; cb: Largeint; dwLockType: Longint): HResult; stdcall;
    function UnlockRegion(libOffset: Largeint; cb: Largeint; dwLockType: Longint): HResult; stdcall;
    function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult; stdcall;
    function Clone(out stm: IStream): HResult; stdcall;
    function Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult; stdcall;
    function Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult; stdcall;
  end;

type
  TRobot = class(TInterfacedObject, IStream)
  private
    FStream: TRobotStream;
    function GetStream: IStream;
  public
    destructor Destroy; override;
    property Stream: IStream read GetStream implements IStream;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  rs: IStream;
begin
  rs := TRobot.Create;
  LoadRobotFromDatabase(rs); //dummy method, just to demonstrate we use the stream
  rs := nil;
end;

procedure TForm1.LoadRobotFromDatabase(rs: IStream);
begin
  rs.Revert; //dummy method call, just to prove we can call it
end;

function TRobotStream.Clone(out stm: IStream): HResult;
begin
end;

function TRobotStream.Commit(grfCommitFlags: Integer): HResult;
begin
end;

function TRobotStream.CopyTo(stm: IStream; cb: Largeint; out cbRead, cbWritten: Largeint): HResult;
begin
end;

function TRobotStream.LockRegion(libOffset, cb: Largeint; dwLockType: Integer): HResult;
begin
end;

function TRobotStream.Read(pv: Pointer; cb: Integer; pcbRead: PLongint): HResult;
begin
end;

function TRobotStream.Revert: HResult;
begin
end;

function TRobotStream.Seek(dlibMove: Largeint; dwOrigin: Integer;
  out libNewPosition: Largeint): HResult;
begin
end;

function TRobotStream.SetSize(libNewSize: Largeint): HResult;
begin
end;

function TRobotStream.Stat(out statstg: TStatStg; grfStatFlag: Integer): HResult;
begin
end;

function TRobotStream.UnlockRegion(libOffset, cb: Largeint; dwLockType: Integer): HResult;
begin
end;

function TRobotStream.Write(pv: Pointer; cb: Integer; pcbWritten: PLongint): HResult;
begin
end;

destructor TRobot.Destroy;
begin
  FStream.Free;
  inherited;
end;

function TRobot.GetStream: IStream;
begin
  if FStream = nil then
     FStream := TRobotStream.Create(Self);
  result := FStream;
end;

end.

回答2:

There is no need for your class that does the delegation to inherit from any particular class. You could inherit from TObject provided the appropriate methods have been implemented. I'll keep things simple and illustrate using TInterfacedObject which provides the 3 core methods which you have already identified.

Also, you should not need TRobotStream = class(TAggregatedObject, IUnknown, IStream). You could instead simply declare that IStream inherits from IUnknown. By the way, I always give my interfaces a GUID (Press the conbination Ctrl+Shift+G).

There are a number of different approaches and techniques that can be applied depending on your particular needs.

• Delegating to interface type
• Delegating to class Type
• Method aliasing

The simplest delegation is by interface.

TRobotStream = class(TinterfacedObject, IStream)

TRobot = class(TInterfacedObject, IStream)
private
  //The delegator delegates the implementations of IStream to the child object.
  //Ensure the child object is created at an appropriate time before it is used.
  FRobotStream: IStream;
  property RobotStream: IStream read FRobotStream implements IStream;
end;

There are perhaps a few thing to watch out for:

• Ensure the objects you're delegating to have an appropriate lifetime.
• Be sure to hold a reference to the delegatee. Remember that interfaces are reference counted, and will be destroyed as soon as the count drops to zero. This may actually have been the cause of your headaches.