12

在 Delphi 中，IUnknown声明为：

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

注意：输出参数是无类型的

在我的TInterfacedObject后代中我需要处理QueryInterface，所以我可以返回一个支持请求接口的对象：

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;

问题来了：

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

德尔福抱怨：

运算符不适用于此操作数类型

显然，我不知道如何或将什么分配给无类型 out参数。我可以随机尝试，希望编译器不再抱怨：

Obj := TFooBar.Create(Self);

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

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

忽略我编写的所有代码（如果需要）：我如何QueryInterface在一个对象后代中实现TInterfacedObject？

我一直试图解决的真正问题可以归结为我想要：

我想覆盖接口中的方法

以同样的方式：

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

可以在后代类中覆盖：

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

我想对接口也一样：

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;

问题是我必须如何开始加载我的实现对象：

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;

中不仅有两种方法IFoo，还有 6 种。然后如果我想添加另一个支持的接口：

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;

事情变得非常笨拙非常快。

4

3 回答 3

6

您需要对赋值语句的左侧进行类型转换。这样，无类型参数就有了类型，编译器知道如何给它赋值：

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

请注意，您违反了 COM 的要求之一。如果您查询一个接口，您应该能够查询 IUnknown 的结果并始终获得相同的值：

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

如果您只想生成 TFooBar 类型的新对象，请为您的接口提供一个生成这些对象的方法：

function TFoo.NewFooBar: IFooBar;
begin
  Result := TFooBar.Create(Self) as IFooBar;
end;
于 2010-07-21T20:39:27.417 回答
3

除了 Rob 在这里打破规则的言论之外，您甚至可以通过以下构造获得成功：

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;

我没有对此进行调查，但您可能会在引用计数方面遇到一些问题......

于 2010-07-21T20:46:46.900 回答
2

基于 System.pas 中 TObject.GetInterface 的实现，我建议这样做：

  Pointer(Obj) := TFooBar.Create(Self);
于 2010-07-21T20:37:05.237 回答