Delphi: как реализовать QueryInterface для IUnknown?

В 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;

И вещи становятся действительно громоздкими очень быстро.


person Ian Boyd    schedule 21.07.2010    source источник
comment
Я также призываю вас задать вопрос о вашей реальной проблеме. Звучит интересно, и у меня есть смутное представление о том, как это сделать (кое-что о агрегатах и контейнерах). Вы можете обнаружить, что пишете больше кода, чем нужно.   -  person Rob Kennedy    schedule 23.07.2010
comment
@Rob Kennedy Если вы можете придумать для него полезное название, которое вызовет интерес, я обязательно это сделаю. я считаю, что без хорошего крючка вопрос останется без ответа. Этот вопрос был хорош, потому что вопрос в его формулировке звучал легко — так что я втягивал людей, которые думали, что смогут дать мне легкое образование. С другой стороны, вы с Уве, кажется, патрулируете вопросы Delphi :)   -  person Ian Boyd    schedule 23.07.2010


Ответы (3)


Вам необходимо преобразовать левую часть оператора присваивания. Таким образом, нетипизированный параметр имеет тип, и компилятор знает, как присвоить ему значение:

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;
person Rob Kennedy    schedule 21.07.2010
comment
Я могу решить одну проблему (всегда возвращать одно и то же IUnknown), используя ключевое слово implements, и делегировать новый интерфейс классу адаптера, созданному в методе получения свойств. Но да, это по-прежнему вызывает другую проблему новых объектов каждый раз. мне пришлось бы кэшировать n-объектов, по одному для каждого из n-поддерживаемых интерфейсов. вздох Обновлен исходный вопрос с актуальной проблемой, которую я пытаюсь решить. - person Ian Boyd; 22.07.2010

Помимо замечаний Роба о нарушении правил здесь, вы даже можете добиться успеха с этой конструкцией:

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;

Я не исследовал это, но у вас могут возникнуть проблемы с подсчетом ссылок...

person Uwe Raabe    schedule 21.07.2010
comment
Это, безусловно, крутая идея. Но я думаю, вы правы, мне нужно добавить вызов _AddRef где-то там. - person Ian Boyd; 22.07.2010
comment
Я не думаю, что у вас возникнут здесь проблемы с подсчетом ссылок. Счетчик ссылок будет равен 1, пока работает конструктор. Когда конструктор возвращается, счетчик обнуляется, но объект не удаляет себя (см. TInterfacedObject.AfterConstruction). Затем вызывается метод QueryInterface нового объекта, который устанавливает для вас счетчик ссылок. - person Rob Kennedy; 22.07.2010
comment
Вызов QueryInterface() для объекта TFooBar обрабатывает необходимый _AddRef() для вас. QueryInterface() всегда увеличивает счетчик ссылок возвращаемого интерфейса. - person Remy Lebeau; 22.07.2010
comment
Как я уже сказал, я не расследовал. Я знал, что есть более мудрые люди, которые уже знают ответ;) - person Uwe Raabe; 22.07.2010

Основываясь на реализации TObject.GetInterface в System.pas, я бы предложил следующее:

  Pointer(Obj) := TFooBar.Create(Self);
person Ville Krumlinde    schedule 21.07.2010
comment
После этого вам нужно будет позвонить _AddRef. Чтобы вызвать это, вам нужно привести тип Obj к типу интерфейса. Лучше просто сначала привести к типу интерфейса, как в моем ответе. - person Rob Kennedy; 22.07.2010
comment
Вы правы, _AddRef нужен, я должен был скомпилировать и попробовать его перед публикацией. - person Ville Krumlinde; 22.07.2010