Коллекции во внешнем COM-сервере. Простое решение.

Добрый день дорогие коллеги!

В этой заметке пойдет речь о создании внешнего COM-сервера и реализации в нем простой коллекции. Что я подразумеваю под коллецией. Под ней я подразумеваю,то что некий COM сервер имеет грубо говоря некий набор данных к которым нужно получить доступ. А так как набор данных может быть разным то нужно предоставить пользователям возможность получать эти данные проходом по коллеции. Классическим примером может служить COM-сервер MS Excel который предоставляет пользователям коллецию рабочих листов IWorkSheet. Что-то подобное в простом решении мы сейчас и реализуем.

Итак для примера создадим простой проект и поместим в него список ListBox. Заполнив его несколькими элементами.

Cоздадим новый объект автоматизации.

 

 В появившемся окне введем в поле CoClass Name имя класса реализующего данный сервер автоматизации (в нашем случае Main) и интерфейс IMain

 

После чего в появившейся бибилиотеки типов мы создадим дополнительно два интерфейса IDataItem - интерфейс элемента данных и IDataItemCollections - коллекция элементов данных. Для данных интерфейсов создадим также и классы реализующие их функциональнойсть для этого с помощь кнопки New CoClass создадим новые классы: DataItem и  DataCollections

Эти классы свяжем с соответсвующими интерфейсами. Для это выберем нужный класс, на вкладке Implements щелкнем правой клавишей  и в меню выберем Insert Interface. В появившемся окне свяжем наш интерфейс с классом.

После того как мы связали оба наших класса с нужными интерфейсами приступим к реализации методов наших интерфейсов.

В интерфейсе IMain создадим метод DataCollections, который будет предоставлять доступ к интерфейсу коллеции IDataCollections. После создания метода перейдем на вкладку Parameters и заполним ее так как показано на рисунке:

Внимание! Обратите внимание что параметр Collections возвращает указатель на указатель интерфейса IDataCollections. Т.е тип парамета должен быть IDataCollections**. Именно с двумя звездочками. Многие новички по первости путают это и пишут с одной звездочкой, указывая просто указатель на интерфейс. Если так делать, то потом в работе нашего сервера (при обращении клиента за интерфейсом) будут возникать ошибки cвязанные с доступом к памяти - access denied, т.к класс поддерживающий интерфейс сразу будет уничтожаться сервером после передачи интерфейса клиенту. 
Стоит также отметить то, что среда Delphi, как бы провоцирет прикладного программиста на использование  IDataCollections*  при выборе из списка параметров. 
Имейте это ввиду - если вы хотите из метода возвращать интерфейс всегда возвращайте УКАЗАТЕЛЬ НА УКАЗАТЕЛЬ ИНТЕРФЕЙСА

  

Далее перейдем к интерфейсу IDataItem и введем свойство для чтения Name, в которм мы будем вовзращать имя элемента из списка ListBox

Перейдем к интерфейсу IDataCollections и определим два свойства - Count и Items (в первом будет возращаться количество элементов в списке ListBox, во втором предоставляться доступ к интерфейсу IDataItem который будет возращать имя элемента из списка по индексу).

Далее на скриншотах показаны параметры этих методов:

 

Итак интерфейсы и методы в библиотеке типов мы описали, перейдем к реализации. Что бы долго не ходить, представлю исходный код сервера:

{

На заметку!

Если вы хотите возвращать интерфейс из методов и свойств то его нужно объявлять
как IDispatch ** или IMyInterface ** - т.е. как указатель на указатель интерфейса

}
unit COMRealizations;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, DemoCollections_TLB, StdVcl, Dialogs;

type
  TDemo = class(TAutoObject, IMain)
  protected
    procedure Test; safecall;
    function DataCollections: IDataCollections; safecall;
  end;

  {Элемент}
  TDataItem = class(TAutoObject, IDataItem)
  private
    FName : String;
  protected
    function Get_Name: WideString; safecall;
  end;

  {Коллекция}
  TDataCollections = class(TAutoObject, IDataCollections)
  Private
  protected
    constructor Create;
    {IDataCollections}
    function Get_Count: Integer; safecall;
    function Items(Index: Integer): IDataItem; safecall;
  end;


implementation

uses Main, ComServ;


{ TDataItem }

{ TDemo }
function TDemo.DataCollections: IDataCollections; safecall;
var
 DataCollections : TDataCollections;
begin
 Result := nil;
 DataCollections := TDataCollections.Create;   {создаем и возвращаем коллецию}
 Result := DataCollections;
end;

procedure TDemo.Test;
begin
  ShowMessage('Test is TDemo Server COM' + #10#13 + frmMain.ListBox.Items.Text);
end;

{ TDataCollections }
constructor TDataCollections.Create;
begin
 inherited;
end;

function TDataCollections.Get_Count: Integer;
begin
  Result := frmMain.ListBox.Count;
end;

function TDataCollections.Items(Index: Integer): IDataItem; safecall;
var
 Data : TDataItem;
begin
 if (Index >= 0) and (Index <= frmMain.ListBox.Count) then
 begin
     Data := TDataItem.Create;
     Data.FName := frmMain.ListBox.Items.Strings[Index];
     Result := Data;
 end
 else
     Result := nil;
end;

{ TDataItem }

function TDataItem.Get_Name: WideString;
begin
  Result := FName;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TDemo, CLASS_Main, ciMultiInstance, tmApartment);
  TAutoObjectFactory.Create(ComServer, TDataCollections, CLASS_DataCollections, ciMultiInstance, tmApartment);
  TAutoObjectFactory.Create(ComServer, TDataItem, CLASS_DataItem, ciMultiInstance, tmApartment);
end.

Код тестового примера, показывающего простой доступ  к данному серверу.

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActiveX, ComObj, StdCtrls,
  DemoCollections_TLB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Srv : IMain;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 I : Integer;
 vData : IDataCollections;
 vDataItem : IDataItem;
begin
 if Not Assigned(Srv) then
 begin
    Srv   := CoMain.Create;
    if Assigned(Srv) then
    begin
       vData := Srv.DataCollections;
       if Assigned(vData) then
       begin
          ShowMessage('Кол-во элементов:' + IntToStr(vData.Count));
          for I := 0 to vData.Count - 1 do
          begin
              vDataItem := vData.Items(I);
              if Assigned(vDataItem) then
                 ShowMessage('Элемент:' + vDataItem.Name);
          end;
       end;
    end
    else
       ShowMessage('Srv is nil');
 end;
end;

end.

Ну и напоследок, тест на скрипте VBS

Dim Srv, Collect, DataItem
Set Srv = CreateObject("DemoCollections.Main")
Set Collect = Srv.DataCollections

for I = 0 to Collect.Count-1
    Set DataItem = Collect.Items(i)
    MsgBox(DataItem.Name)
next

Вот в принципе и все - простая коллекция реализована.
В дальнейшем мы ее усложним добавив нумератор IEnumVariants.