Общие сведения о COM

Delphi , Технологии , COM и DCOM

Автор: Fantasist
WEB-сайт: http://forum.vingrad.ru

Хотел я в общих словах расказать основную идею СOM. Когда я понял, что это такое показалась такая простая вещь, что можно коротко рассказать. Но не получилось... Что ж, будет немного подлиннее.

Итак, попробуем рассказать в простоте. Вот есть у вас класс - примитивный калькулятор:

MyCalc = class
  fx, fy: integer;
public:
  procedure SetOperands(x, y: integer)

  function Sum: integer;
  function Diff: integer;
end;

procedure MyCalc.SetOperands(x, y: integer)
begin
  fx := x;
  fy := y;
end;

function MyCalc.Sum: integer;
begin
  result := fx + fy;
end;

function MyCalc.Diff: integer;
begin
  result := fx - fy;
end;

Все элементарно. Теперь если у вас есть объект этого класса, то вам не составит труда им воспользоваться. Но представим следующую ситуацию: у вас есть один модуль, где объявлется объект этого класса. Допустим:

unit MyCalc

type
  MyCalc = class
    <описание выше>

var
  Calc: MyCalc;

и теперь вы хотите использовать в другом модуле. Хорошо, скажите Вы, мы его просто подключим, и используем. Но, допустим, вы хотите, чтобы и другие могли пользоваться вашим объектом, даже используея другой компилятор. То есть нужно сделать так, чтобы ваш модуль можно было бы использовать без перекомпиляции. Как это сделать? Ясно, что без каких-то стандартов не обойтись. Скорее всего, самый простой вариант выглядел бы так:

unit MyCalc
type
  MyCalc = class
    < описание выше >

var
  Calc: MyCalc;

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 := MyCalc.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
  MyCalc = class
    fx, fy: integer;
  public
    procedure SetOperands(x, y: integer);
    function Sum: integer;
    function Diff: integer;
  end;
var
  Calc: MyCalc;

procedure MyCalc.SetOperands(x, y: integer);
begin
  fx := x;
  fy := y;
end;

function MyCalc.Sum: integer;
begin
  result := fx + fy;
end;

function MyCalc.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 := MyCalc.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;

Теперь пользователь может ввести какой он хочет интерфейс сложение/вычитание или умножение/деление и получить соответсвующую таблицу методов.

Слышу, слышу. Читатели уже начинают замечать сколько несуразностей в нашем коде. Давайте попробуем приводести его в нормальный вид.

Во первых, неплохо бы избавиться от внешних функций. Сейчас нам приходилось на каждый метод нашего класса добавлять еще одну внешнюю функцию, чтобы этот метод вызывать. Почему мы не можем передпть указатели на методы класса? Дело в том, что указатель на методы класса должен содержать в себе также и указатель на экземпляр класса, чтобы метод мог обращаться к членам этого класса. В Делфи можно задать указатель на функцию класса:

MethodPointer: procedure of object;

Такое обявление увеличивает размер указателя с 4 до 8 байт, что позволяет хранить в нем указатель на экземпляр класса. В принципе, возможно этим воспользоваться и описать процедуры нашего интерфейса как объектные, но это не будет шаг в сторону COM. Так как COM должен обеспечивать единый стандарт в нем используются указатели стандартного размера 4 байта. Как же нам все-таки избавиться от неудобных внешних функций? В разных средах разработки это может быть реализованно по разному, но раз уж мы начали с Delphi, рассмотрим как это реализованно в нем.

В Delphi вводиться ключевое слово - interface. Объявление инерфейса - это и есть объявление таблицы методов. Выглядит это так

IMyInterface = interface
  [{GUID}]
  < метод1 >
  < метод2 >
  ...
end;

GUID - необязательное поле индефицируеющая интерфейс. Тут надо сказать, что GUID(он же UUID, CLSID) - это 128-битное число, алгоритм генерации которого гарантирует его уникальность во вселенной. В Windows его можно получить функцией CoCreateGuid или UuidCreate. В Делфи это очень удобно встроенно в среду, и вы его можете получить нажав Ctrl+Shift+G.

В нашем простом случае это будет выглядить так:

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;

Как и было сказанно, объявление интерфейса это всего лишь объявление таблицы методов. А имплементируется это так:

MyCalc = class(TObject, ICalc) //интерфейс указывается в списке наследования!
  fx, fy: integer;
public
  procedure SetOperands(x, y: integer);
  function Sum: integer;
  function Diff: integer;
  procedure Release;
end;

Все методы класса у нас уже имплементированны, кроме Release. Ну с ним все понятно:

procedure MyCalc.Release;
begin
  Free;
end;

По умолчанию, методы привязываются по именам. То есть если в ICalc указан метод Sum, то компилятор будет искать метод Sum в классе MyCalc. Однако вы можете указать явно другие имена. Например:

MyCalc = class(TObject, ICalc)
  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 в нашем классе.

MyCalc = class(TObject, ICalc)
  fx, fy: integer;
public
  function ICalc.Release = Free;
  procedure SetOperands(x, y: integer);
  function Sum: integer;
  function Diff: integer;
end;

Что же происходит при добовлении к классу интерфейса? Здесь для каждого экземпляра нашего класса создается специальная таблица(interface table), в которой храняться все записи о поддерживаемых интерфейсах. Каждая такая запись содержит адрес соответствующего интерфейса, который в свою очередь, как уже было сказанно является таблицей методов. То есть если мы получим адрес, допустим, нашего ICalc, то вызывая функцию по этому же адресу, мы вызовем метод SetOperands класса MyCalc. 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;

Хочу еще раз отметить, что эти примеры пишутся для Делфи, однако суть от этого не меняется. Как бы не выглядил интерфейс в других средах разработки, он всегда остается таблицой с адресами функций. И если говорить о IUnkown, то он всегда должен содержать эти же методы, в этом же порядке. В С++ он например выглядит так:

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;

Теперь добавим его в наш объект.

MyCalc = 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:MyCalc; //без изменений 
...
 ...
 procedure CreateObject;
 begin
  Calc:=MyCalc.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: MyCalc;
begin
  Calc := MyCalc.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;

  MyCalc = class(TObject, ICalc, ICalc2) //два интерфейса
    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 MyCalc.SetOperands(x, y: integer);
begin
  fx := x;
  fy := y;
end;

function MyCalc.Sum: integer;
begin
  result := fx + fy;
end;

function MyCalc.Diff: integer;
begin
  result := fx - fy;
end;

function MyCalc.Divide: integer;
begin
  result := fx div fy;
end;

function MyCalc.Mult: integer;
begin
  result := fx * fy;
end;

procedure MyCalc.Release;
begin
  Free;
end;

function MyCalc.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function MyCalc._AddRef;
begin
end;

function MyCalc._Release;
begin
end;

procedure CreateObject(const IID: TGUID; var ACalc);
var
  Calc: MyCalc;
begin
  Calc := MyCalc.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. Вначале, добавим счетчик в наш объект:

MyCalc = class(TObject, ICalc, ICalc2)
  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: MyCalc;
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. Этот метод предназначен для того, чтобы гарантировать не уничтожение объекта. То есть поставили замок, и пока его не сняли, обект должен жить. Добавим и этот метод а наш класс.

MyCalc = 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 MyCalc.CreateInstance(const unkOuter: IUnknown; const iid: TIID; out
  obj): HResult; stdcall;
var
  Calc: MyCalc;
begin
  Calc := MyCalc.Create;
  if not Calc.GetInterface(IID, Obj) then
  begin
    Result := E_NOINTERFACE;
    Calc.Free;
    exit;
  end;
  Result := S_OK;
end;

function MyCalc.LockServer(fLock: BOOL): HResult; stdcall;
begin
  if fLock then
    _AddRef
  else
    Release;
end;

Реализация CreateInstance полностью идентична последним восми строчкам функции DllGetClassObject - просто создаем объект и возвращаем интерфейс, если мы его поддерживаем. С LockServer тоже все просто: если fLock=true тогда увеличиваем счетчик вызовом _AddRef, иначе уменьшаем его вызывая Release.

Ну теперь еще раз. Компилируем dll, тестер менять не надо, и запускаем... Свершилось! Наш калькулятор был создан системной функцией CoCreateInstance!

What a comprehensive and detailed guide to COM objects in Delphi! You've covered everything from the basics of COM (Component Object Model) and its role in Windows, to implementing interfaces and creating a COM object in Delphi. Your examples are clear a

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: COM и DCOM ::