Общие сведения о COM (статья)

Эта статья целиком и полностью написана Fantasist'ом, за что ему огромное спасибо.
Хотел я в общих словах рассказать основную идею СOM. Когда я понял, что это такое показалась такая простая вещь, что можно коротко рассказать. Но не получилось...
Что ж, будет немного подлиннее.
== Простой пример ==
Итак, попробуем рассказать в простоте. Вот есть у вас класс - примитивный калькулятор:
type
 TMyCalc = class
 public
 fx, fy: Integer;
 procedure SetOperands(x, y: Integer)
 function Sum: Integer;
 function Diff: Integer;
 end;
procedure TMyCalc.SetOperands(x, y: Integer);
begin
 fx := x;
 fy := y;
end;
function TMyCalc.Sum: Integer;
begin
 Result := fx + fy;
end;
function TMyCalc.Diff: Integer;
begin
 Result := fx - fy;
end;
Все элементарно. Теперь если у вас есть объект этого класса, то вам не составит труда им воспользоваться.
Но представим следующую ситуацию: у вас есть один модуль, где объявляется объект этого класса. Допустим:
unit MyCalc;
type
 TMyCalc = class; // описание выше
var
 Calc: TMyCalc;
и теперь вы хотите использовать в другом модуле. Хорошо, скажите Вы, мы его просто подключим, и используем. Но, допустим, вы хотите, чтобы и другие могли пользоваться вашим объектом, даже используя другой компилятор. То есть нужно сделать так, чтобы ваш модуль можно было бы использовать без перекомпиляции. Как это сделать?
Ясно, что без каких-то стандартов не обойтись. Скорее всего, самый простой вариант выглядел бы так:
unit MyCalc;
type
 TMyCalc = class; // описание выше
var
 Calc: TMyCalc;
procedure SetOperands(x, y: Integer)
begin
 Calc.SetOperands(x, y);
end;
function Sum: Integer;
begin
 Result := Calc.Sum;
end;
function Diff: Integer;
begin
 Result := Calс.Diff;
end;
procedure CreateObject;
begin
 Calc := TMyCalc.Create;
end;
procedure ReleaseObject;
begin
 Calc.Free;
end;
Откомпилировать этот юнит, посмотреть, по какому адресу находятся функции SetOperands, Sum, Diff, CreateObject и ReleaseObject и приложить документацию где эти адреса будут указаны. Теперь каждый сможет загрузить ваш модуль в память и по адресу указанном в вашей документации вызвать нужную функцию.
Понятно, чем такой подход чреват. Это крайне не удобно. Но, эта проблема была поставлена давно, и теперь у нас есть стандартизированное соглашение об экспорте функций. То есть вместо того, чтобы писать для каждого модуля документацию с адресами функций при компиляции в заголовке модуля создается специальная стандартная таблица где указаны имена этих функций и их адреса (также указывается числовой идентификатор, который может быть использован вместо имени). Теперь уже лучше. Для того чтобы вызвать ваши функции, достаточно загрузить ваш модуль в память прочитать таблицу экспорта, и можно по именам в ней найти адреса функций и их вызвать. Так устроены DLL. Сейчас все это поддерживается компиляторами, и Windows API. То есть вам самому ничего этого делать не надо, а достаточно вызвать LoadLibrary, чтобы загрузить ваш модуль в память, и GetProcAddress чтобы получить адрес функции по имени.
== DLL! ==
Ура. До нас и за нас все уже стандартизировали. Давайте этим воспользуемся и напишем теперь наш модуль по стандарту. Напишем DLL.
library CalcDll;
uses SysUtils, Classes;
type
 TMyCalc = class
 private
 fx, fy: Integer;
 public
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Diff: Integer;
 end;
var
 Calc: TMyCalc;
procedure TMyCalc.SetOperands(x, y: Integer);
begin
 fx := x;
 fy := y;
end;
function TMyCalc.Sum: Integer;
begin
 Result := fx + fy;
end;
function TMyCalc.Diff: Integer;
begin
 Result := fx - fy;
end;
procedure SetOperands(x, y: Integer);
begin
 Calc.SetOperands(x, y);
end;
function Sum: Integer;
begin
 Result := Calc.Sum;
end;
function Diff: Integer;
begin
 Result := Calc.Diff;
end;
procedure CreateObject;
begin
 Calc := TMyCalc.Create;
end;
procedure ReleaseObject;
begin
 Calc.Free;
end;
// Вот эта секция и указывает компилятору что записать в таблицу экспорта
exports
 SetOperands,
 Sum,
 Diff,
 CreateObject,
 ReleaseObject;
begin
end.
Напишем программку - протестировать наш модуль.
unit tstcl;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 Button2: TButton;
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 end;
var
 Form1: TForm1;
 _Mod: Integer; // идентификатор модуля
 SetOpers: procedure(x, y: Integer); // Это все указатели на функции,
 diff, sum: function: Integer; // которые мы собираемся получить
 CreateObj, ReleaseObj: procedure; // из нашего модуля
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
 // загружаем наш модуль в память
 _Mod := LoadLibrary('CalcDll.dll');
 // получаем адреса функций по именам
 CreateObj := GetProcAddress(_Mod, 'CreateObject');
 ReleaseObj := GetProcAddress(_Mod, 'ReleaseObject');
 sum := GetProcAddress(_Mod, 'Sum');
 diff := GetProcAddress(_Mod, 'Diff');
 SetOpers := GetProcAddress(_Mod, 'SetOperands');
 CreateObj(); // вызываем функцию по адресу
 SetOpers(13, 10); // вызываем функцию по адресу
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 ReleaseObj(); // опять вызываем функцию по адресу
 FreeLibrary(_Mod); // выгружаем модуль из памяти
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(IntToStr(diff)); // вычисляем разницу
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 ShowMessage(IntToStr(sum)); // вычисляем сумму
end;
end.
Классно! Теперь каждый программирующий в системе Windows на любом языке может использовать наш калькулятор! Что? Разочарованны? Такое ощущение что COM тут и не пахнет?
Правильно, ибо про СОМ я пока ничего и не сказал, но
Продолжение следует!
== Еще шаг в направлении COM ==
Сделаем еще шаг в направлении Component Object Module (COM). Даже сейчас у экспортируется довольно много функций. Соответственно, и в программе нам надо сделать несколько ступеней - создать переменную-указатель, присвоить ей значение адреса нужной функции при помощи GetProcAddress, и только потом вызвать саму функцию. Причем все эти функции у нас сами по себе и никак не связанны с самим объектом, который мы используем. А неплохо бы сделать так, чтобы можно было работать с ними как с объектом, что-нибудь типа:
 Сalc.SetOperands(13, 10);
 i := Calc.Sum;
Так давайте так и сделаем! Правда мы ограничены экспортом только функций, но мы сделаем так:
Добавим в dll такую запись
type
 ICalc = record
 SetOpers: procedure(x, y: Integer);
 Sum: function: Integer;
 Diff: function: Integer;
 Release: procedure;
 end;
и процедуру:
procedure GetInterface(var Calc: ICalc);
begin
 CreateObject;
 Calc.Sum := Sum;
 Calc.Diff := Diff;
 Calc.SetOpers := SetOperands;
 Calc.Release := ReleaseObject;
end;
и будем экспортировать только ее:
exports
 GetInterface;
Видите что происходит? Теперь вместо того, чтобы получать адрес каждой функции, мы можем получить сразу всю таблицу адресов. Причем создание объекта происходит в этой же функции, и пользователю больше не нужно знать функцию CreateObject и не забыть ее вызвать.
Переделаем наш тестер.
В описание типов добавим:
type
 ICalc = record
 SetOpers: procedure(x, y: Integer);
 Sum: function: Integer;
 Diff: function: Integer;
 Release: procedure;
 end;
изменим секцию var.
var
 Form1: TForm1;
 _Mod: Integer;
 GetInterface: procedure(var x: ICalc);
 Calc: ICalc;
и процедуры где мы используем наш объект.
procedure TForm1.FormCreate(Sender: TObject);
begin
 _Mod := LoadLibrary('CalcDll.dll');
 GetInterface := GetProcAddress(_Mod, 'GetInterface');
 GetInterface(Calc);
 Calc.SetOpers(13, 10);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 Calc.Release;
 FreeLibrary(_Mod);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(IntToStr(Calc.diff));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 ShowMessage(IntToStr(Calc.Sum));
end;
Теперь со стороны может показаться, что мы пользуемся объектом, хотя на самом деле это всего лишь таблица с указателями на функции.
== Понятие интерфейса ==
Тут наконец проявляется одно из ключевых понятий COM - интерфейс (interface).
Наша запись ICalc - это он и есть. То есть интерфейс - это таблица содержащая указатели на функции. Когда вы работаете с COM объектом, несмотря на то, что это выглядит так, как будто вы работаете с самим объектом, вы работаете с его интерфейсами. Реализация здесь может быть разная, это может быть указатели на внешние функции, как это сделано у нас (так практически никто не делает), но чаще всего это указатели на методы класса. Пользователя это не волнует - он получает интерфейс и с ним работает, а уж ваша задача потрудиться над тем, чтобы работа с вашим интерфейсом проходила корректно.
Мы можем создать несколько интерфейсов. Допустим, добавим в наш класс две функции:
procedure MyCalc.Mult; // умножение
begin
 Result := fx * fy;
end;
procedure MyCalc.Divide; // деление
begin
 Result := fx div fy;
end;
ну и придется добавить еще две внешние функции:
procedure Mult;
begin
 Calc.Mult
end;
procedure Divide;
begin
 Calc.Divide;
end;
и переделаем GetInterface:
procedure GetInterface(IID: Integer; var Calc: ICalc); // IID - Interface ID (идентификатор интерфейса)
begin
 CreateObject;
 if IID = 1 then
 begin
 Calc.Sum := Sum;
 Calc.Diff := Diff;
 end
 else
 if IID = 2 then
 begin
 Calc.Sum := Mult;
 Calc.Diff := Divide;
 end;
 Calc.SetOpers := SetOperands;
 Calc.Release := ReleaseObject;
end;
Теперь пользователь может ввести какой он хочет интерфейс сложение/вычитание или умножение/деление и получить соответствующую таблицу методов.
Слышу, слышу. Читатели уже начинают замечать сколько несуразностей в нашем коде. Давайте попробуем привести его в нормальный вид.
Во первых, неплохо бы избавиться от внешних функций. Сейчас нам приходилось на каждый метод нашего класса добавлять еще одну внешнюю функцию, чтобы этот метод вызывать. Почему мы не можем передать указатели на методы класса? Дело в том, что указатель на методы класса должен содержать в себе также и указатель на экземпляр класса, чтобы метод мог обращаться к членам этого класса. В Delphi можно задать указатель на функцию класса:
 MethodPointer: procedure of object;
Такое объявление увеличивает размер указателя с 4 до 8 байт, что позволяет хранить в нем указатель на экземпляр класса. В принципе, возможно этим воспользоваться и описать процедуры нашего интерфейса как объектные, но это не будет шаг в сторону COM. Так как COM должен обеспечивать единый стандарт в нем используются указатели стандартного размера 4 байта. Как же нам все-таки избавиться от неудобных внешних функций? В разных средах разработки это может быть реализовано по-разному, но раз уж мы начали с Delphi, рассмотрим как это реализовано в нем.
В Delphi вводится ключевое слово - interface. Объявление интерфейса - это и есть объявление таблицы методов. Выглядит это так:
type
 IMyInterface = interface
 [{GUID}]
 <метод1>
 <метод2>
 ...
 end;
GUID - необязательное поле, идентифицирующее интерфейс. Тут надо сказать, что GUID (он же UUID, CLSID) - это 128-битное число, алгоритм генерации которого гарантирует его уникальность во вселенной. В Windows его можно получить функцией CoCreateGuid или UuidCreate. В Delphi это очень удобно встроено в среду, и вы его можете получить нажав Ctrl+Shift+G.
В нашем простом случае это будет выглядеть так:
type
 ICalc = interface
 ['{149D0FC0-43FE-11D6-A1F0-444553540000}']
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Diff: Integer;
 procedure Release;
 end;
Объявленный таким образом интерфейс можно прицепить к классу. Причем, заметьте, что методы интерфейса имплементируются только в классе, к которому они прицеплены. То есть вот так вы написать не можете:
function ICalc.Sum: Integer;
begin
 Result := 0;
end;
Как и было сказано, объявление интерфейса это всего лишь объявление таблицы методов. А имплементируется это так:
type
 TMyCalc = class(TObject, ICalc) // интерфейс указывается в списке наследования!
 private
 fx,fy: Integer;
 public
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Diff: Integer;
 procedure Release;
 end;
Все методы класса у нас уже имплементированы, кроме Release. Ну с ним все понятно:
procedure TMyCalc.Release;
begin
 Free;
end;
По умолчанию, методы привязываются по именам. То есть если в ICalc указан метод Sum, то компилятор будет искать метод Sum в классе TMyCalc. Однако вы можете указать явно другие имена. Например:
type
 TMyCalc = class(TObject, ICalc)
 private
 fx, fy: Integer;
 public
 function ICalc.Diff = Difference; // задаем нужное имя (Difference)
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Difference: Integer; // другое имя
 procedure Release;
 end;
В нашем случае, удобно назначить метод Release методу Free, это избавит нас от необходимости имплементировать Release в нашем классе.
type
 TMyCalc = class(TObject, ICalc)
 private
 fx, fy: Integer;
 public
 function ICalc.Release = Free;
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Diff: Integer;
 end;
Что же происходит при добавлении к классу интерфейса? Здесь для каждого экземпляра нашего класса создается специальная таблица (interface table), в которой хранятся все записи о поддерживаемых интерфейсах. Каждая такая запись содержит адрес соответствующего интерфейса, который в свою очередь, как уже было сказано, является таблицей методов. То есть если мы получим адрес, допустим, нашего ICalc, то вызывая функцию по этому же адресу, мы вызовем метод SetOperands класса TMyCalc. Ecли вы вызовете вызовете функцию по адресу <адрес ICalc>+4 то вызовется метод Sum. Еще +4 байта будет метод Diff. То есть, здесь указатели на функции имеют размер 4 байта, и адрес нужной функции получают прибавлением нужного смещения к адресу интерфейса.
Получить же адрес нужного интерфейса можно с помощью метода GetInterface класса TObject.
Забудем пока, что мы делали два интерфейса, и вернемся к варианту с одним интерфейсом. Перепишем наш GetInterface.
procedure GetInterface(var ACalc: ICalc);
begin
 CreateObject;
 Calc.GetInterface(ICalc, ACalc);
end;
Мы воспользовались методом GetInterface, который выглядит так:
function TObject.GetInterface(const IID: TGUID; out Obj): Boolean;
Он возвращает в параметре Obj указатель на интерфейс, по указанному идентификатору GUID. Допускается вместо переменной типа TGIUD поставить имя интерфейса - компилятор сам подставит его GUID если он ему известен.
Все. Выбрасывайте все внешние функции, кроме GetInterface. Теперь нам придется сказать спасибо Borland'у и сделать несколько дополнительных действий. Дело в том, что по стандарту COM каждый COM объект должен имплементировать интерфейс IUnknown. Он содержит три метода и выглядит так:
 IUnknown = interface
 ['{00000000-0000-0000-C000-000000000046}']
 function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
 function _AddRef: Integer; stdcall;
 function _Release: Integer; stdcall;
 end;
Хочу еще раз отметить, что эти примеры пишутся для Delphi, однако суть от этого не меняется. Как бы не выглядел интерфейс в других средах разработки, он всегда остается таблицей с адресами функций. И если говорить о IUnknown, то он всегда должен содержать эти же методы, в этом же порядке. В С++ он например выглядит так:
struct IUnknown
{
 HRESULT QueryInterface(REFIID iid, void ** ppvObject);
 ULONG AddRef(void);
 ULONG Release(void);
}
Так вот, в Delhpi все интерфейсы наследуются от IUnknown. Так что и наш интерфейс тоже содержит эти методы, а значит и компилятор потребует от вас их имплементации. Ну что ж. Добавьте пока пустые методы QueryInterface, _AddRef и _Release, позже мы их имплементируем правильно.
Теперь не забудьте поменять тип ICalc на интерфейс в тестере, и убедитесь, что все работает. :)
== Понятие интерфейса - 2 ==
Давайте теперь вернем наш второй интерфейс. Теперь, когда таблица интерфейсов создается компилятором, мы не можем эмулировать два интерфейса простой заменой адресов функций. Теперь нам действительно надо создать второй интерфейс. Хорошо, что интерфейсы можно наследовать:
 ICalc2 = interface(ICalc)
 function Mult: Integer;
 function Divide: Integer;
 end;
Tак ICalc2 будет содержать в себе все методы ICalc. Нам Sum и Diff в этом интерфейсе не нужны, так что давайте лучше напишем так:
 ICalcBase = interface // здесь нам GUID не нужен, так как с этим интерфейсом мы работать не собираемся.
 procedure SetOperands(x, y: Integer);
 procedure Release;
 end;
 ICalc = interface(ICalcBase)
 ['{149D0FC0-43FE-11D6-A1F0-444553540000}']
 function Sum: Integer;
 function Diff: Integer;
 end;
 ICalc2 = interface(ICalcBase)
 ['{D79C6DC0-44B9-11D6-A1F0-444553540000}']
 function Mult: Integer;
 function Divide: Integer;
 end;
Теперь добавим его в наш объект.
 TMyCalc = class(TObject, ICalc, ICalc2)
 ... // без изменений
 function Divide: Integer; // это и
 function Mult: Integer; // это добавили
 end;
Опять возьмемся за наш GetInterface. В принципе, мы могли бы оставить выбор интерфейса как было у нас раньше - передаем в GetInterface целую переменную и если она равна 1 то возвращаем ICalc, а если 2 то ICalc2.
Но уж коли мы связались с COM, то давайте будем, по возможности, к нему приближаться. Сделаем полную аналогию GetInterface в TObject:
function GetInterface(const IID: TGUID; var ACalc): Boolean;
begin
 CreateObject;
 Result := Сalc.GetInterface(IID, ACalc);
 if not Result then
 Calc.Free;
end;
Вуаля! Чувствуется, насколько теперь лучше, чем было в начале? Теперь, если запрашиваемый интерфейс нашим объектом не поддерживается, то во-первых, мы даем клиенту об этом узнать, возвращая в Calc nil (TObject.GetInterface это делает) и возвращая False из функции, а во-вторых, мы сразу же освобождаем объект. Но на самом деле, то что во-вторых, ничего хорошего нет, ибо мы подходим к следующей проблеме.
Функцию мы обозвали GetInterface, но она еще и объект создает! А если пользователь захотел получить вначале ICalc, а потом ICalc2? Так как ему известна лишь функция GetInterface, он может воспользоваться только ей и получит два объекта, вместо двух интерфейсов одного объекта. Значит нужно отделить функции создание объекта, от получение его интерфейса. Давайте попробуем это сделать.
Первая попытка:
var
 Calc: TMyCalc; // без изменений
procedure CreateObject;
begin
 Calc := TMyCalc.Create;
end;
function GetInterface(const IID: TGUID; var ACalc): Boolean;
begin
 Result := Сalc.GetInterface(IID, ACalc);
end;
exports
 CreateObject, // добавили в экспорт
 GetInterface;
Хм... Не работает, не правда ли? Если клиент сделает так:
CreateObject;
CreateObject;
GetInterface(ICalc, Calc);
то он получит интерфейс второго созданного объекта, тогда как первый объект будет навсегда утерян. Что же надо сделать? Надо сделать так, чтобы CreateObject возвращала бы чего-нибудь, чтобы мы могли идентифицировать объект, и получать именно его интерфейсы. Как я уже сказал, клиент работает с COM объектом только через его интерфейсы, значит логичнее всего при создании объекта вернуть интерфейс созданного объекта (точнее, указатель на него). Для нашего случая, можно возвращать указатель на ICalc, но можно облегчить жизнь пользователю, и попросить его указать, какой интерфейс он хочет.
procedure CreateObject(const IID: TGUID; var ACalc);
var
 Сalc: TMyCalc;
begin
 Calc := TMyCalc.Create;
 if not Calc.GetInterface(IID, ACalc) then
 Calc.Free;
end;
Здесь если интерфейса, который пользователь попросит нас нет, мы вернем nil и удалим объект. Если интерфейс есть, то пользователь сам будет удалять объект через метод Release. Неплохо, не правда ли?
Теперь глобальная переменная Calc нам не нужна - мы создаем много объектов динамически.
Ну теперь совсем очевидно, что если пользователь захочет еще один интерфейс этого объекта, то логичнее всего у этого объекта этот интерфейс и попросить. Вот мы уже вплотную подошли к имплементации IUnknown - основного интерфейса в COM. Как я уже сказал, все объекты должны имплементировать IUnknown, и все интерфейсы должны быть потомками IUnknown (что Borland и сделал). Так что вы помните, что и оба наших интерфейса ICalc и ICalc2 являются потомками IUnknown, а значит и первые три метода, которые они содержат - это QueryInterface, AddRef, Release. Помните, я предлагал вам оставить эти три метода пустыми? Давайте сейчас имплементируем один из них - QueryInterface:
function MyCalc.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
 if GetInterface(IID, Obj) then
 Result := S_OK;
 else
 Result := E_NOINTERFACE;
end;
HResult это тоже, что и Longint, только его значение определятся соглашением принятым в COM.
== Собираем тестовый пример ==
Теперь, давайте соберем код. Прошу учесть, что практически не делается никаких проверок - это демонстрационный код. Но работающий.
В начале код dll c объектом.
library CalcDll;
uses
 SysUtils,
 Classes;
type
 HResult = LongInt;
 ICalcBase = interface // чисто абстрактный интерфейс
 procedure SetOperands(x, y: Integer);
 procedure Release;
 end;
 ICalc = interface(ICalcBase)
 ['{149D0FC0-43FE-11D6-A1F0-444553540000}']
 function Sum: Integer;
 function Diff: Integer;
 end;
 ICalc2 = interface(ICalcBase)
 ['{D79C6DC0-44B9-11D6-A1F0-444553540000}']
 function Mult: Integer;
 function Divide: Integer;
 end;
 TMyCalc = class(TObject, ICalc, ICalc2) // два интерфейса
 private
 fx, fy: Integer;
 public
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Diff: Integer;
 function Divide: Integer;
 function Mult: Integer;
 procedure Release;
 function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
 function _AddRef: LongInt; stdcall;
 function _Release: LongInt; stdcall;
 end;
const
 S_OK = 0;
 E_NOINTERFACE = HRESULT($80004002);
procedure TMyCalc.SetOperands(x, y: Integer);
begin
 fx := x;
 fy := y;
end;
function TMyCalc.Sum: Integer;
begin
 Result := fx + fy;
end;
function TMyCalc.Diff: Integer;
begin
 Result := fx - fy;
end;
function TMyCalc.Divide: Integer;
begin
 Result := fx div fy;
end;
function TMyCalc.Mult: Integer;
begin
 Result := fx * fy;
end;
procedure TMyCalc.Release;
begin
 Free;
end;
function TMyCalc.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
 if GetInterface(IID, Obj) then
 Result := S_OK
 else
 Result := E_NOINTERFACE;
end;
function TMyCalc._AddRef;
begin
end;
function TMyCalc._Release;
begin
end;
procedure CreateObject(const IID: TGUID; var ACalc);
var
 Calc: TMyCalc;
begin
 Calc := TMyCalc.Create;
 if not Calc.GetInterface(IID, ACalc) then
 Calc.Free;
end;
exports
 CreateObject;
begin
end.
А теперь тестер.
unit tstcl;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls,ComObj;
type
 //обратите внимание! Используем один унифицированный интерфейс
 IUniCalc = interface
 procedure SetOperands(x, y: Integer);
 procedure Release;
 function Sum: Integer;
 function Diff: Integer;
 end;
 TForm1 = class(TForm)
 Button1: TButton;
 Button2: TButton;
 Button3: TButton;
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 procedure Button3Click(Sender: TObject);
 end;
var
 Form1: TForm1;
 _Mod: Integer; // хэндл модуля
 СreateObject: procedure (IID: TGUID; out Obj); // процедура из dll.
 Calc: IUniCalc; // это указатель на интерфейс который мы будем получать
 ICalcGUID: TGUID;
 ICalc2GUID: TGUID;
 flag: Boolean; // какой интерфейс активный.
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
 _Mod := LoadLibrary(PChar('C:\Kir\COM\SymplDll\CalcDll.dll'));
 // Эти GUID я просто скопировал из исходника CalcDll.dll
 ICalcGUID := StringToGUID('{149D0FC0-43FE-11D6-A1F0-444553540000}');
 ICalc2GUID := StringToGUID('{D79C6DC0-44B9-11D6-A1F0-444553540000}');
 flag := True;
 СreateObject := GetProcAddress(_Mod, 'CreateObject');
 СreateObject(ICalcGUID, Calc);
 if Calc <> nil then
 Calc.SetOperands(10, 5);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 if Calc <> nil then
 Calc.Release;
 FreeLibrary(_Mod);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(IntToStr(Calc.diff));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 ShowMessage(IntToStr(Calc.Sum));
end;
procedure TForm1.Button3Click(Sender: TObject);
var
 tmpCalc: IUniCalc;
begin
 if flag then
 Calc.QueryInterface(ICalc2GUID, tmpCalc)
 else
 Calc.QueryInterface(ICalcGUID, tmpCalc);
 flag := not flag;
 Calc := tmpCalc;
end;
end.
Обратите внимание, что происходит при нажатии на кнопку3. Мы используем ту же самую переменную, для работы со вторым интерфейсом! Этот пример показывает, что получая указатель на интерфейс, его методы мы получаем за счет смещения, от адреса который этот указатель содержит. Короче, мы получаем адрес таблицы методов.
Потыкайте, посмотрите что происходит.
== Стандарт СОМ ==
Продолжаем, осталось совсем немного, чтобы подогнать под стандарт COM.
Какой у нас пробел еще остался? Представьте, что кто-то сделал так:
var
 Calc: ICalc;
 Calc2: ICalc2;
begin
 CreateObject(ICalc, Calc);
 Calc.QueryInterafce(ICalc2, Calc2)
 {...}
 Calc.Release; // объект уничтожается
 i := Calc2.Mult; // Облом! Объекта уже нет.
 {...}
end;
Не очень хорошо, не правда ли? Нужно все-таки сохранить объект, пока им кто-то пользуется. Очевидное решение - подсчет ссылок. То есть, если у нашего объекта попросили интерфейс, мы увеличим счетчик, если кому-то интерфейс больше не нужен, мы уменьшим счетчик, и как только он обратиться в 0 мы уничтожим объект. Вот и настала пора, имплементировать последние два метода в интерфейса IUnknown. Вначале, добавим счетчик в наш объект:
type
 TMyCalc = class(TObject, ICalc, ICalc2)
 private
 fx, fy: Integer;
 FRrefCount: LongInt; // вот он!
 public
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Diff: Integer;
 function Divide: Integer;
 function Mult: Integer;
 procedure Release;
 function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
 function _AddRef: LongInt; stdcall;
 function _Release: LongInt; stdcall;
 end;
и имплементируем методы:
function MyCalc._AddRef: LongInt;
begin
 Result := InterlockedIncrement(FRefCount);
end;
function MyCalc._Release: LongInt;
begin
 Result := InterlockedDecrement(FRefCount);
 if Result = 0 then
 Destroy;
end;
Именно так, как правило, выглядят эти два метода в реализациях под Windows. Теперь в нашем интерфейсе Release не нужен, и можно его оттуда выкинуть. Итак, клиент должен вызывать Release для того, чтобы дать объекту знать, что он его больше не будет использовать, а кто должен вызывать AddRef? Во-первых, мы сами, всегда, когда клиент получает от нас интерфейс. Если бы мы не писали на Delphi, это надо было бы делать в методе QueryInterface, однако в Delhpi метод GetInterface класса TObject сам вызывает AddRef, так что нам заботиться об этом не надо. Надо сказать, что и клиент может вызвать AddRef, ecли по каким-то причинам, не желает чтобы объект исчез из памяти. Но тут уж вся ответственность на нем.
Надо сказать еще об одной особенности Delphi, касательно использования COM объектов (а точнее интерфейсов) в своих приложениях. Как было упомянуто выше, клиент должен вызывать Release для того, чтобы объект знал, когда ему можно удалиться. Так вот для переменных типа interface Delphi сам вызывает Release, если переменная уничтожается или если ей присваивается nil. То есть:
var
 ifc: IUnknown;
begin
 ifc := SomeComObj.QueryInterface(IUnknown, ifc);
 {...}
 ifc := nil; // здесь вызывается ifc._Release
end;
var
 ifc: IUnknown;
begin
 ifc := SomeComObj.QueryInterface(IUnknown, ifc);
 {...}
end; // теперь где-то здесь ifc._Release (перед уничтожением ifc).
Так что всегда имейте это ввиду: как минимум один раз Release будет вызван без вашего указания.
var
 ifc: IUnknown;
begin
 ifc := SomeComObj.QueryInterface(IUnknown, ifc);
 ifc._Release;
end; // Access violation! Объекта уже нет и вызов ifc._Release проваливается!
Ну вот у нас теперь практически полноценный COM объект. Чем же он еще не полноценен? Наверно вы уже догадались - он не универсален с точки зрения системы. То есть создать его можно лишь подключив загрузив вручную нашу dll и вызвав CreateObject. Но ведь в Windows есть возможность вызывать СOM объекты даже просто по имени! Как это делается? Понятно, что в системе существует правило, как создавать COM объекты. И если мы хотим, чтобы система знала как создать наш MyCalc, мы должны сделать его по этим правилам. Именно этим мы и займемся.
Но в начале, небольшое резюме.
Итак СOM - это битовый стандарт, то есть он обеспечивает совместимость на битовом уровне. С СOM объектами работают через их интерфейсы. Интерфейс - это таблица методов, указатель на которую мы можем получить у объекта. Каждый СОМ объект имплементирует интерфейс IUnknown, который содержит три метода: QueryInterface, AddRef и Release (это стандартные имена, но в принципе вы можете дать любые. Так как совмещение идет на битовом уровне, то важен лишь порядок в котором расположены эти методы в таблице, а так же тип метода (набор параметров, тип возвращаемого значения, тип вызова)). Все интерфейсы должны быть потомками IUnknown, то есть у каждого интерфейса первые три метода это QueryInterface, AddRef и Release. Интерфейсы идентифицируются по GUID. Для того, чтобы получить у объекта какой-то интерфейс, нужно знать его (интерфейса) GUID. То есть название интерфейса неважно для COM - оно используется для удобства людей. Вы можете назвать его IMyInterface, но если его GUID равен {00000000-0000-0000-C000-000000000046}, то все в COM'e (случайная игра слов) будут думать, что это IUnknown.
Ну вот в основном все, пойдем дальше.
== Как система создаёт объект СОМ ==
Итак, давайте посмотрим как система создает СОМ объект. (Все, что написано далее про создание СОМ объекта, не является стандартом СOM, а является поддержкой работы COM системой. То есть так поддержка реализована в Windows. В других системах поддержка COM (если вы ее там найдете) может быть реализована по другому.) Наиболее часто используемая API функция в Windows для создания СОМ объекта это CoCreateInstance (все названия функций Win API для работы с СОМ имеют префикс Со). Выглядит она так:
STDAPI CoCreateInstance(
 REFCLSID rclsid,
 LPUNKNOWN pUnkOuter,
 DWORD dwClsContext,
 REFIID riid,
 LPVOID * ppv
 );
Давайте запишем ее в паскалевском виде, и прокомментируем:
function CoCreateInstance(
 const clsid: TCLSID; // Идентификатор класса объект которого мы хотим создать (это, как всегда, GUID)
 unkOuter: IUnknown; // указатель на интерфейс агрегирующего объекта (агрегирование мы рассматривать пока не будем поэтому он у нас будет nil)
 dwClsContext: Longint; // контекст в котором объект должен быть создан объект
 const iid: TIID; // идентификатор интерфейса который мы хотим получить (это тоже GUID)
 out pv // переменная в которую будет записан полученный интерфейс
): HResult; stdcall;
Параметр dwClsContext указывает, как должен быть создан объект. Если мы хотим создавать наш калькулятор c помощью CoCreateInstance, этот параметр будет равен CLSCTX_INPROC_SERVER, то есть внутрипроцессный сервер, так как наш объект находиться внутри dll и не может работать как отдельный процесс. Значит создание нашего объекта будет выглядеть примерно так:
var
 Calc: ICalc;
begin
 CoCreateInstance({GUID нашего класса которого у наc пока нет}, nil, CLSCTX_INPROC_SERVER, ICalc, Calc);
 {...}
end;
Итак, у нас нет GUID нашего класса. Ну, его придумать не проблема, нажал в Delphi Ctrl+Shift+G и GUID готов (особо крутые программисты могут написать свою программку генерации GUID, которая будет состоять из одного вызова API функции СoCreateGUID или UuidCreate). А как система узнает о том, что этот GUID принадлежит нашему классу? Правильно, пора заглянуть в реестр. Открываем ключ HKEY_CLASSES_ROOT\CLSID и видим длинный список GUID'ов. Именно в этом списке находятся все GUID зарегистрированных COM классов (GUID классов чаще называют CLSID - Class ID). При вызове CoCreateInstance в этом списке ищется тот GUID который равен параметру CLSID и если он находится, то рассматривается параметр dwClsContext, и в соответствии с ним ищется следующий подключ:
* если dwClsContext = CLSCTX_INPROC_SERVER ищется подключ InprocServer32
* если dwClsContext = CLSCTX_INPROC_HANDLER ищется подключ InprocHandler32
* если dwClsContext = CLSCTX_LOCAL_SERVER ищется подключ LocalServer32
и если он существует, то значение этого ключа будет указывать путь к модулю в котором находиться исполняемый код класса.
Итак, чтобы зарегистрировать наш класс, нужно создать новый GUID (пусть это будет {2563AE40-AC27-11D6-A5C2-444553540000} ) и создать в реестре новый раздел HKEY_CLASSES_ROOT\CLSID\{2563AE40-AC27-11D6-A5C2-444553540000}, а в нем создать еще один подраздел InprocServer32 и в значение по умолчанию записать путь к нашей dll, у меня это C:\Kir\COM\SymplDll\CalcDll.dll. Отлично, теперь система знает где искать наш класс. Теперь давайте посмотрим как она этот класс создает.
А создает она его так (сейчас мы говорим только о in-proc сервере). Найденная библиотека (dll) с классом загружается в память и в ней вызывается функция DllGetClassObject! Вот основная функция которую наша библиотека должна содержать, и через которую система и создает COM объект. Как она выглядит и что она должна делать? Выглядит она вот так:
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
а делать она должна то, что делает сейчас наша функция CreateObject - создавать класс.
По сравнению с CreateObject добавляется еще один параметр CLSID, так как библиотека может содержать больше чем один класс, то этот параметр указывает объект какого класса нужно создать. Если параметр CLSID содержит неизвестный нашей библиотеке GUID то функция должна вернуть CLASS_E_CLASSNOTAVAILABLE.
Давайте перепишем наш CreateObject на DllGetClassObject:
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
var
 Calc: TMyCalc;
begin
 if GUIDToString(CLSID) <> '{2563AE40-AC27-11D6-A5C2-444553540000}' {GUID нашего класса} then
 begin
 Result := CLASS_E_CLASSNOTAVAILABLE;
 exit;
 end;
 Calc := MyCalc.Create;
 if not Calc.GetInterface(IID, Obj) then
 begin
 Result := E_NOINTERFACE;
 Calc.Free;
 exit;
 end;
 Result := S_OK;
end;
exports
 // Не забыть добавить в список экспорта!
 DllGetClassObject;
Итак, первой строчкой проверяем, является ли спрашиваемый идентификатор класса(CLSID) идентификатором нашего класса, который мы недавно придумали, с помощью Delphi, а далее как было раньше, пытаемся записать в переменную Obj указатель на интерфейс того интерфейса, GUID которого был нам передан в качестве параметра IID. Если такой интерфейс нашим классом не поддерживается, освобождаем объект и возвращаем ошибку. Если же все нормально, возвращаем S_OK, а в выходном параметре Obj будет находиться указатель на спрашиваемый интерфейс.
Так же перепишем в тестере процедуру, где мы создаем наш COM калькулятор - это TForm1.FormCreate:
procedure TForm1.FormCreate(Sender: TObject);
begin
 ICalcGUID := StringToGUID('{149D0FC0-43FE-11D6-A1F0-444553540000}');
 ICalc2GUID := StringToGUID('{D79C6DC0-44B9-11D6-A1F0-444553540000}');
 flag := True;
 if СoCreateInstance(StringTOGUID('{2563AE40-AC27-11D6-A5C2-444553540000}'), nil, CLSCTX_INPROC_SERVER, ICalcGUID, Calc) = S_OK then
 Calc.SetOperands(10, 5)
 else
 begin
 ShowMessage('Failed to create Calc');
 Close;
 end;
end;
Как вы видите, мы не загружаем здесь библиотеку в память, чтобы потом вызвать из нее соответствующую функцию для создания объекта, а перепоручаем всю эту работу CoCreateInstance.
В качестве идентификатора класса мы передаем GUID нашего класса, а в качестве идентификатора интерфейса передаем GUID интерфейса ICalc. Ну а сам указатель на интерфейс должен записаться в переменную Calc.
Ну все. Все готово, теперь все компилируем и запускаем... Объект не создается! CoCreateInstance возвращает REGDB_E_CLASSNOTREG - класс не зарегистрирован. Но на самом деле ошибка не в том, что класс не зарегистрирован. А в чем? Давайте пройдемся пошагово по нашей dll. Поставим брекпойнт на первую линию функции DllGetClassObject. Мы видим, что эта функция вызывается, что CLSID соответствует GUID нашего класса, что сам объект создается, но что дальше? Метод GetInterface не находит спрашиваемого интерфейса! Посмотрите чему равен параметр IID и вы увидите, что он не равен GUID интерфейса ICalc, который мы передавали CoCreateInstance, а равен он вот такому значению: {00000001-0000-0000-C000-000000000046}. Можно заглянуть в реестр Windows, чтобы узнать, что интерфейс с таким GUID носит название IClassFactory. Что ж, выходит CoCreateInstance просит не тот интерфейс, который мы предаем ей как параметр. Microsoft не скрывает реализацию CoCreateInstance - это, на самом деле, всего лишь вспомогательная функция и делает она следующее (вольный перевод на Delphi):
function CoCreateInstance(const clsid: TCLSID; unkOuter: IUnknown; dwClsContext: Longint; const IID: TIID; out pv): HResult; stdcall;
var
 p: IClassFactory;
begin
 CoGetClassObject(CLSID, dwClsContext, nil, IClassFactory, p);
 Result = p.CreateInstance(unkOuter, IID, pv);
end;
Первой строчкой вызывается API функция CoGetClassObject, параметры у нее точно такие же как у CoCreateInstance, и как раз она является основной функцией - она находит библиотеку с классом и вызывает DllGetClassObject (опять же, это все для in-proc серверов). И как видите, она действительно просит интерфейс IClassFactory. Что бы понять, что делает следующая строчка, нужно рассмотреть еще один официальный и широко известный интерфейс IClassFactory.
== IClassFactory ==
Итак, IClassFactory предназначен для того, чтобы создавать экземпляры соответствующего класса. То есть строчкой:
 CoGetClassObject(Calc_CLSID, dwClsContext, nil, IClassFactory, p); // Calc_CLSID - GUID нашего калькулятора
мы должны получить интерфейс, с помощью которого мы сможем создавать сколь угодно много наших калькуляторов (конкретнее: экземпляров нашего класса MyCalc). Для этого вызывается метод этого интерфейса CreateInstance. Параметры у него до боли знакомые - они точно такие же как три последних параметра у СoCreateInstance или CoGetClassObject. CLSID уже не нужен, так как данный интерфейс принадлежит классу, который создает только объекты определенного класса - того CLSID которого мы указали в СoCreateInstance, который потом передался в CoGetClassObject и который наконец попал в DllGetClassObject.
Видите, тут довольно забавно получается - мы просим создать объект и выдать для этого объекта интерфейс IClassFactory, с помощью которого мы будем создавать эти же объекты. В принципе, мы совершаем лишнее действие, если собираемся создать только один объект, однако если мы хотим создать множество объектов, то такой путь более эффективен, чем многократный вызов CoCreateInstance или CoGetClassObject, поэтому он и был утвержден.
Чисто теоретически, мы можем сделать так (для нашего калькулятора):
var
 p: IClassFactory;
 Calc: ICalc;
begin
 // создаем объект (MyCalc) и получаем для него интерфейс IClassFactory
 CoGetClassObject(StringTOGUID('{2563AE40-AC27-11D6-A5C2-444553540000}'), nil, CLSCTX_INPROC_SERVER, IClassFactory, p);
 // получаем интерфейс ICalc
 p.QueryInterface(ICalcGUID, Calc);
end;
Ибо IClassFactory, как и любой интерфейс, является потомком IUnknown, и поддерживает метод QueryInterface (как AddRef и Release, который Delphi вызывает автоматически). Единственная загвоздка состоит в том, что несмотря на то, что этот интерфейс вроде должен принадежать только что созданному объекту MyCalc, во многих реализациях он ему не принадлежит. Ну у нас то, конечно, пока еще вообще никакой реализации нет, но если бы это делал кто-то другой, то возможно он бы реализовал DllGetClassObject так:
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
var
 Calc: TObject;
begin
 if GUIDToString(CLSID) <> '{2563AE40-AC27-11D6-A5C2-444553540000}' {GUID нашего класса} then
 begin
 Result := CLASS_E_CLASSNOTAVAILABLE;
 exit;
 end;
 // если cпрашивается IClassFactory, то создаем класс-фабрику.
 if IID = IClassFactory then
 Calc := CalcFactory.Create
 else
 Calc := MyCalc.Create;
 if not Calc.GetInterface(IID, Obj) then
 begin
 Result := E_NOINTERFACE;
 Calc.Free;
 exit;
 end;
 Result := S_OK;
end;
То есть, создается один экземпляр маленького класса CalcFactory, который ничего больше не умеет, кроме как создавать калькуляторы (экземпляры класса MyCalc). Естественно, он поддерживает интерфейс IClassFactory. Такая реализация не редка и попытка получить у такого класса-фабрики интерфейс настоящего класса может закончится ошибкой.
Мы же давайте пойдем другим путем, и просто дополним наш класс интерфейсом IClassFactory. Для этого мы можем сами создать интерфейс IClassFactory, как мы раньше создавали ICalc и ICalc2, а можем воспользоваться готовым описанием, включив в uses библиотеку ActiveX. Так оно выглядит там:
 IClassFactory = interface(IUnknown)
 ['{00000001-0000-0000-C000-000000000046}']
 function CreateInstance(const unkOuter: IUnknown; const iid: TIID;
 out obj): HResult; stdcall;
 function LockServer(fLock: BOOL): HResult; stdcall;
 end;
Как видите, помимо CreateInstance здесь так же есть метод LockServer. Этот метод предназначен для того, чтобы гарантировать не уничтожение объекта. То есть поставили замок, и пока его не сняли, объект должен жить. Добавим и этот метод а наш класс.
 TMyCalc = class(TObject, ICalc, ICalc2, IClassFactory)
 fx, fy: Integer;
 FRefCount: Integer;
 public
 constructor Create;
 procedure SetOperands(x, y: Integer);
 function Sum: Integer;
 function Diff: Integer;
 function Divide: Integer;
 function Mult: Integer;
 procedure Release;
 function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
 function _AddRef: LongInt; stdcall;
 function _Release: LongInt; stdcall;
 // IClassFactory
 function CreateInstance(const unkOuter: IUnknown; const iid: TIID; out obj): HResult; stdcall;
 function LockServer(fLock: BOOL): HResult; stdcall;
 end;
Реализация:
function TMyCalc.CreateInstance(const unkOuter: IUnknown; const iid: TIID; out obj): HResult; stdcall;
var
 Calc: TMyCalc;
begin
 Calc := TMyCalc.Create;
 if not Calc.GetInterface(IID, Obj) then
 begin
 Result := E_NOINTERFACE;
 Calc.Free;
 exit;
 end;
 Result := S_OK;
end;
function TMyCalc.LockServer(fLock: BOOL): HResult; stdcall;
begin
 if fLock then
 _AddRef
 else
 Release;
end;
Реализация CreateInstance полностью идентична последним восьми строчкам функции DllGetClassObject - просто создаем объект и возвращаем интерфейс, если мы его поддерживаем. С LockServer тоже все просто: если fLock = True тогда увеличиваем счетчик вызовом _AddRef, иначе уменьшаем его вызывая Release.
Ну теперь еще раз. Компилируем dll, тестер менять не надо, и запускаем... Свершилось! Наш калькулятор был создан системной функцией CoCreateInstance!
Author: Fantasist
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 04312
Category:COM