Delphi : Comment implémenter QueryInterface de IUnknown ?

Question

Dans Delphi, IUnknown est déclaré comme :

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

Note : Le paramètre de sortie n'est pas typé

Dans mon TInterfacedObject descendant que je dois gérer QueryInterface Ainsi, je peux retourner un objet qui supporte l'interface demandée :

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;

Le problème vient de la ligne :

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

Delphi se plaint :

Opérateur non applicable à ce type d'opérande

De toute évidence, je ne sais pas comment ou quoi assigner à un groupe d'utilisateurs. non typée out Je peux essayer des choses au hasard, dans l'espoir que le compilateur arrête de se plaindre :

Obj := TFooBar.Create(Self);

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

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

En ignorant tout le code que j'ai écrit (si nécessaire) : comment puis-je mettre en œuvre QueryInterface dans un objet descendant de TInterfacedObject ?

---

Le vrai problème que j'ai essayé de résoudre peut se résumer à "je veux" :

Je veux remplacer des méthodes dans une interface

De la même manière :

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

peut être surchargée dans une classe descendante :

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

Je veux faire de même avec les 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;

Le problème est que je dois commencer à charger mon objet d'implémentation avec :

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;

Et il n'y a pas que les deux méthodes en IFoo il y en a 6. Et puis si je veux ajouter une autre interface supportée :

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;

Et les choses deviennent très vite difficiles à manier.

Answer 1

Vous devez taper le gauche du côté de la déclaration d'affectation. De cette façon, le paramètre non typé a un type, et le compilateur sait comment lui attribuer une valeur :

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

---

S'il vous plaît noter que vous brisez l'une des les exigences de COM . Si vous interrogez une interface, vous devriez pouvoir interroger le résultat pour IUnknown et obtenir toujours la même valeur :

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

Si vous voulez simplement générer de nouveaux objets de type TFooBar, donnez à votre interface une méthode qui les génère :

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

Answer 2

En plus des remarques de Rob sur le fait de briser les règles ici, vous pouvez même réussir avec cette construction :

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;

Je ne l'ai pas étudié, mais vous pourriez avoir des problèmes avec le comptage des références...

Answer 3

Sur la base de l'implémentation de TObject.GetInterface dans System.pas, je suggérerais ceci :

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