Delfos:Como implementar QueryInterface de IUnknown?

Question

Em Delfos, IUnknown é declarado como:

function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

Observação: O parâmetro de saída não é digitado

No meu TInterfacedObject descendente eu preciso lidar QueryInterface, para que eu possa retornar um objeto que suporte a interface solicitada:

function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
   if IsEqualGUID(IID, IFooBar) then
   begin
      Obj := (TFooBar.Create(Self) as IFooBar);
      Result := S_OK;
   end
   else
      Result := inherited QueryInterface(IID, {out}Obj);
end;

O problema vem na linha:

Obj := (TFooBar.Create(Self) as IFooBar);

Delphi reclama:

Operador não aplicável a este tipo de operando

Obviamente não sei como ou o que atribuir a um não digitado out parâmetro.posso tentar coisas aleatoriamente, na esperança de que o compilador pare de reclamar:

Obj := TFooBar.Create(Self);

Obj := Pointer(TFooBar.Create(Self));

Obj := Pointer(TFooBar.Create(Self) as IFooBar);

Ignorando todo o código que escrevi (se necessário):como faço para implementar QueryInterface em um objeto descendente de TInterfacedObject?

---

O verdadeiro problema que estou tentando resolver pode ser resumido em eu quero:

eu quero substituir métodos em uma interface

Do mesmo jeito:

TList = class(TObject)
...
   function GetItem(Index: Integer): Pointer; 
   procedure SetItem(Index: Integer; Value: Pointer);
   property Items[Index: Integer]: Pointer read GetItem write SetItem;
end;

pode ser substituído em uma classe descendente:

TStudentList = class(TList)
...
   function GetItem(Index: Integer): TStudent; 
   procedure SetItem(Index: Integer; Value: TStudent);
   property Items[Index: Integer]: TStudent read GetItem write SetItem;
end;

eu quero fazer o mesmo com interfaces:

IFoo = interface(IUnknown)
...
   function GetItem(Index: Variant): Variant; 
   procedure SetItem(Index: Variant; Value: Variant);
   property Items[Index: Variant]: Variant read GetItem write SetItem;
end;

IFooGuidString = interface(IFoo)
...
   function GetItem(Index: TGUID): string ; 
   procedure SetItem(Index: TGUID; Value: string );
   property Items[Index: TGUID]: string read GetItem write SetItem;
end;

O problema é que preciso começar a carregar meu objeto de implementação com:

TFoo = class(TInterfacedObject, IFoo, IFooGuidString)
public
   function IFoo.GetItem = FooGetItem;
   procedure IFoo.SetItem = FooSetItem;
   function FooGetItem(Index: Variant): Variant; 
   procedure FooSetItem(Index: Variant; Value: Variant);

   function IFooGuidString.GetItem = FooGuidStringGetItem;
   procedure IFooGuidString.SetItem = FooGuidStringSetItem;
   function FooGuidStringGetItem(Index: TGUID): string ; 
   procedure FooGuidStringSetItem(Index: TGUID; Value: string );
end;

E não existem apenas os dois métodos em IFoo, há 6.E então, se eu quiser adicionar outra interface compatível:

IFooInt64String = interface(IFoo)
...
   function GetItem(Index: Int64): string ; 
   procedure SetItem(Index: Int64; Value: string );
   property Items[Index: Int64]: string read GetItem write SetItem;
end;


TFoo = class(TInterfacedObject, IFoo, IFooGuidString)
public
   function IFoo.GetItem = FooGetItem;
   procedure IFoo.SetItem = FooSetItem;
   function FooGetItem(Index: Variant): Variant; 
   procedure FooSetItem(Index: Variant; Value: Variant);

   function IFooGuidString.GetItem = FooGuidStringGetItem;
   procedure IFooGuidString.SetItem = FooGuidStringSetItem;
   function FooGuidStringGetItem(Index: TGUID): string ; 
   procedure FooGuidStringSetItem(Index: TGUID; Value: string );

   function IFooInt64String.GetItem = FooInt64StringGetItem;
   procedure IFooInt64String.SetItem = FooInt64StringSetItem;
   function FooInt64StringGetItem(Index: Int64): string ; 
   procedure FooInt64StringSetItem(Index: Int64; Value: string );
end;

E as coisas ficam realmente difíceis de controlar muito rápido.

Answer 1

Você precisa digitar o esquerda lado da instrução de atribuição.Dessa forma, o parâmetro sem tipo possui um tipo e o compilador sabe como atribuir um valor a ele:

IFooBar(Obj) := TFooBar.Create(Self) as IFooBar;

---

Observe que você está quebrando um dos requisitos de COM.Se você consultar uma interface, poderá consultar o resultado para IUnknown e sempre obter o mesmo valor:

Foo.QueryInterface(IUnknown, I1);
I1.QueryInterface(IFooBar, B);
B.QueryInterface(IUnknown, I2);
Assert(I1 = I2);

Se você deseja apenas gerar novos objetos do tipo TFooBar, forneça à sua interface um método que os gere:

function TFoo.NewFooBar: IFooBar;
begin
  Result := TFooBar.Create(Self) as IFooBar;
end;

Answer 2

Além dos comentários de Rob sobre quebrar as regras aqui, você pode até ter sucesso com esta construção:

function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
   if IsEqualGUID(IID, IFooBar) then
      Result := TFooBar.Create(Self).QueryInterface(IID, obj)
   else
      Result := inherited QueryInterface(IID, {out}Obj);
end;

Eu não investiguei isso, mas você pode ter alguns problemas com a contagem de referências...

Answer 3

Com base na implementação de TObject.GetInterface em System.pas eu sugeriria o seguinte:

  Pointer(Obj) := TFooBar.Create(Self);