Королевство Дельфи"Knowledge itself is power"
F.Bacon
 Лицей
  
Главная
О лицее

Список семинаров

 
 К н и г и
 
Книжная полка
 
 
Библиотека
 
  
  
 


Поиск
 
Поиск по КС
Поиск в статьях
Яndex© + Google©
Поиск книг

 
  
Тематический каталог
Все манускрипты

 
  
Карта VCL
ОШИБКИ
Сообщения системы

 
Форумы
 
Круглый стол
Новые вопросы

 
  
Базарная площадь
Городская площадь

 
   
С Л С

 
Летопись
 
Королевские Хроники
Рыцарский Зал
Глас народа!

 
  
ТТХ
Конкурсы
Королевская клюква

 
Разделы
 
Hello, World!
Лицей

Квинтана

 
  
Сокровищница
Подземелье Магов
Подводные камни
Свитки

 
  
Школа ОБЕРОНА

 
  
Арсенальная башня
Фолианты
Полигон

 
  
Книга Песка
Дальние земли

 
  
АРХИВЫ

 
 

Сейчас на сайте присутствуют:
 
  
 
Во Флориде и в Королевстве сейчас  02:15[Войти] | [Зарегистрироваться]

Урок 17. Пример стандартного маршалинга

Антон Григорьев
дата публикации 19-06-2008 12:25

урок из цикла: Использование COM/DCOM в Delphi


предыдущий урок содержание семинара  

Урок 17. Пример стандартного маршалинга

В этом уроке мы рассмотрим, как написать сервер и клиент, использующие стандартный маршалинг. Как мы уже говорили, создание такого сервера исключительно средствами Delphi — задача очень трудоёмкая, так как Delphi не имеет средств автоматической генерации proxy/stub dll. Поэтому для создания этой библиотеки мы будем использовать утилиту midl.exe и компилятор Visual C++. Действия, необходимые для компиляции proxy/stub dll, будут описаны очень подробно, чтобы это мог сделать человек, который использует Visual C++ от случая к случаю или вообще не использует. Начиная с Visual Studio 7 интерфейс этой IDE сильно изменился, и те же по сути действия в старом и новом интерфейсах выполняются разными командами. Поэтому последовательность действий будет дана для двух версий Visual Studio: 6 (характерный представитель старого интерфейса) и 2005 (характерный представитель нового интерфейса).

Сервер и клиент будут во многом похожи на те, что были разработаны в качестве примера для универсального маршалинга — это поможет сравнить два способа решения одной задачи. Но на этот раз мы не будем передавать идентификатор клиента и заводить метод для сложения двух чисел — предполагается, что читатель уже достаточно хорошо разобрался с технологией COM/DCOM, чтобы при необходимости сделать такие вещи самостоятельно. С другой стороны, чтобы подчеркнуть дополнительные возможности, которые даёт более сложный в реализации стандартный маршалинг, мы будем дополнительно передавать от сервера клиенту данные в виде бинарного дерева, реализованного с помощью указателей. Такую структуру данных невозможно передать в рамках универсального маршалинга, там бинарное дерево пришлось бы реализовывать в виде более громоздкого массива записей, в которых хранились бы индексы дочерних элементов.

Окно сервера показано на рисунке 1. Поле Memo, занимающее большую часть окна, выполняет ту же функцию, что и поле Memo в сервере с библиотекой типов — является хранилищем строк, которые сервер возвращает клиенту. Так же, как и раньше, клиент смодет получить длины всех строк и содержимое заинтересовавших его строк. В левой части окна расположено дерево и кнопки "Add Item" и "Delete Item", позволяющие пользователю создавать и удалять узлы этого дерева. Названия узлов также можно менять. Это дерево будет передаваться клиенту.


Рисунок 1. Окно сервера

Таким образом, нам понадобятся три функции: для передачи массива длин строк, для передачи выбранных строк и для передачи дерева. Посмотрим описание типов и интерфейса на языке MIDL (в прилагаемом к уроку архиве это файл DataTransfer.idl в папке IDL).

import "oaidl.idl";

typedef struct _TreeItemRec
{
  [string] char* ItemName;
  [unique] struct _TreeItemRec* Sibling;
  [unique] struct _TreeItemRec* Child;
} TTreeItemRec;

[
  object,
  uuid(66CD4649-96EC-4DC8-8E87-FE9303AB6BC8),
  pointer_default(unique)
]
interface IDataTransfer : IUnknown
{
  HRESULT GetStringLengths(
    [out] int* Count,
    [out, size_is(, *Count)] int** StringLengths
  );

  HRESULT GetStrings(
    [in] int Count,
    [in, size_is(Count)] int* Numbers,
    [out, size_is(, Count)] BSTR** Strings
  );

  HRESULT GetTreeData(
    [out]  TTreeItemRec** Root
  );
}

[
  uuid(3145A636-2DDA-4308-B437-742417B33E4F),
  version(1.0)
]
library DataTransfer
{
  importlib("stdole32.tlb"); 
  interface IDataTransfer;
}

Запись TreeItemRec используется для хранения информации об одном элементе дерева. Поле ItemName хранит указатель на имя элемента (атрибут string указывает на то, что это обычная строка, завершающаяся нулём), Sibling — указатель на следующий элемент того же уровня, Child — указатель на первый дочерний элемент. Легко видеть, что всё дерево можно представить как структуру из таких элементов, указывающих друг на друга. Эту структуру формирует метод IDataTransfer.GetTreeData, который возвращает указатель на вершину дерева.

Метод GetStringLengths возвращает массив целый чисел, содержащий длины строк, введённых пользователем в поле ввода. Выходной параметр Count показывает количество элементов в выходном массиве StringLengths. Сами строки возвращает метод GetStrings. Здесь параметр Count является входным, а входной массив Numbers содержит номера строк, которые клиент хочет получить от сервера. Эти строки возвращаются в соответствующих элементах выходного массива Strings (т.е. если Numbers[i] содержал число N, то Strings[i] будет содержать N-ую строку). Так как клиент, в принципе, может передать неверный номер строки в каком-то элементе массива Numbers, следует предусмотреть средство контроля ошибок. Договоримся следующим образом: если передан неверный номер, в соответствующем элементе массива Strings будет возвращён nil (так как указатель у нас будет иметь вид unique, можем себе такое позволить). Чтобы отличать ошибку от пустой строки, которые могут встретиться в Memo, пустые строки будем возвращать как ненулевой указатель на символ #0.

Для трансляции этого файла не нужно никаких дополнительных параметров, просто выполняем его командой

midl DataTransfer.idl

На выходе получаем пять файлов: DataTransfer.h, DataTransfer_i.c, DataTransfer.tlb, DataTransfer_p.c и DllData.c. Для тех, у кого нет транслятора midl, эти файлы содержатся в папке IDL_Translation, находящейся в приложенном к уроку архиве.

Теперь построим на основе этих файлов библиотеку proxy/stub dll для описанного нами интерфейса. В Visual C++ 6-ой версии для этого нужно выполнить следующие действия:

  1. Открываем окно создания нового проекта (меню File\New, вкладка Projects), вводим имя проекта (например, DataTransfer_ps), выбираем тип проекта Win32 Dynamic-Link Library, нажимаем OK.
  2. В открывшемся окне выбираем An empty DLL project и нажимаем Finish.
  3. Добавляем в проект файлы DataTransfer_i.c, DataTransfer_p.c и DllData.c (меню Project\Add To Project\Files).
  4. Добавляем макросы REGISTER_PROXY_DLL и _WIN32_DCOM. Для этого открываем окно настроек проекта (меню Project\Settings), в поле Settings For выбираем All Configurations, переключаемся на закладку C/C++ и в поле Preprocessor definitions добавляем указанные макросы, отделяя их от остальных макросов и друг от друга запятыми. Окно пока не закрываем.
  5. Переключаемся на закладку Link и добавляем в поле Object/library modules три файла: rpcndr.lib, rpcns4.lib и rpcrt4.lib. Обратите внимание, что в этом поле разделителем является не запятая, а пробел.
  6. Добавляем к библиотеке DEF-файл. Для этого через меню Project\Add to Project\New открываем окно, в нём на вкладке Files выбираем Text File, в поле File name вводим имя файла DataTransfer_ps.def и нажимаем OK.
  7. В созданный DEF-файл вносим следующий текст

LIBRARY DataTransfer_ps.dll
EXPORTS
    DllGetClassObject   PRIVATE
    DllCanUnloadNow     PRIVATE
    DllRegisterServer   PRIVATE
    DllUnregisterServer PRIVATE

После этого проект можно откомпилировать (меню Build\Build DataTransfer_ps.dll). Только не забудьте перед компиляцией переключиться на конфигурацию Win32 Release, чтобы библиотека не получилась неоправданно большой (это делается с помощью выпадающего списка в панели инструментов под главным меню или через меню Build\Set Active Configuration). Полученный в результате компиляции файл DataTransfer_ps.dll и есть требуемая нам proxy/stub dll. На этом её создание успешно завершено, осталось её только зарегистрировать (это делается обычным образом, с помощью утилиты RegSvr32.exe).

Исходные файлы проекта библиотеки лежат в прилагаемом архиве в папке "DataTransfer_ps vc6", а в папке "DataTransfer_ps vc6\Release" — сама откомпилированная библиотека DataTransfer_ps.dll (для тех, у кого нет VC++, и они не могут откомпилировать её самостоятельно).

В Visual Studio 2005 создание аналогичного проекта выгляди следующим образом:

  1. Открываем окно создания нового объекта (меню File\New\Project), в левой части окна в дереве типов проектов находим узел Visual С++ (в зависимости от настроек среды он может быть узлом верхнего уровня или располагаться внутри узла Other Languages), внутри этого узла находим узел Win32, при установке на него в правой части окна появляется список шаблонов, среди которых находим Win32 Project и выбираем его. Вводим имя проекта (например, DataTransfer_ps), нажимаем OK.
  2. В открывшемся окне нажимаем Next, затем в группе Application type выбираем DLL, в группе Additional options отмечаем опцию Empty project и нажимаем Finish.
  3. Добавляем в проект файлы DataTransfer_i.c, DataTransfer_p.c и DllData.c. Для этого в окне Solution Explorer (по умолчанию оно находится справа; если его не видно, его можно открыть с помощью меню View\Solution Explorer) на названии проекта (именно проекта, а всего solution'а) открываем контекстное меню и выбираем там пункт Add\Existing Item.
  4. Добавляем макросы REGISTER_PROXY_DLL и _WIN32_DCOM. Для этого открываем окно свойств проекта (меню Project\Properties), в поле Configuration выбираем All Configurations, в дереве слева выбираем Configuration Properties\C/C++\Preprocessor. В открывшемся справа списке находим поле Preprocessor Definitions и дописываем туда эти два макроса, отделяя их друг от друга и от других макросов точками с запятой. Окно пока не закрываем.
  5. В дереве слева выбираем Configuration Properties\Linker\Input и в поле Additional Dependences справа вводим "rpcndr.lib rpcns4.lib rpcrt4.lib", тем самым добавляя эти файлы к списку импортируемых проектом библиотек. Закрываем окно кнопкой OK.
  6. Добавляем к библиотеке DEF-файл. В окне Solution Explorer открываем контекстное меню проекта (ещё раз напоминаем — проекта, а не всего solution) и выбираем пункт Add\New Item. В открывшемся окне в дереве слева выбираем Visual C++\Code, в правой части — Module-Definition file (.def). Вводим имя файла DataTransfer_ps.def в поле Name, нажимаем OK.
  7. В созданный DEF-файл вносим тот же текст, что и в приведённом выше листинге для VC++ 6 (за исключением первой строки, если она добавлена экспертом автоматически).

Полученный таким образом проект можно откомпилировать (Build/Build solution), предварительно переведя его из конфигурации Debug в Release (с помощью выпадающего списка в панели инструментов под главным меню или меню Build/Configuration manager). При компиляции будут выдаваться предупреждения о неверном приведении типа long к char* и наоборот. На них можно не обращать внимания, эти предупреждения показывают, что данный код несовместим с 64-разрядной платформой, которая нас здесь не интересует. Полученную в результате компиляции библиотеку следует зарегистрировать с помощью утилиты RegSvr32.

Исходные файлы проекта библиотеки лежат в прилагаемом архиве в папке "DataTransfer_ps vs2005".

Теперь, когда мы разобрались с proxy/stub dll, можно переходить к написанию самих приложений. И начнём мы делать это с сервера. Создание окна, показанного на рисунке 1, и написание обработчиков кнопок Add Item и Delete Item мы здесь не комментируем, там всё очевидно. Далее нужно создать модуль, содержащий объявления типов и интерфейсов из исходного файла. С IDL-файлами Delphi работать не умеет, поэтому информацию будем извлекать из tlb-файла, который сгенерировал транслятор midl.exe. Мы уже знаем, что конвертировать библиотеку типов в описание типов на Паскале можно как средствами среды, так и с помощью утилиты tlibimp.exe. Как и раньше, оба способа дают одинаковый результат, можно выбирать любой из них. Правда, в новых версиях Delphi использование tlibimp предпочтительнее, потому что в этих версиях получить нужный нам файл средствами среды можно только если библиотека типов зарегистрирована. Но в данном случае регистрация библиотеки типов для работы сервера не нужна, так что это только захламляет реестр.

Просматривая получившийся файл, мы видим, что не все типы и методы переведены так, как нам хотелось бы. Объявление типов выглядит так (форматирование исправлено, ненужные комментарии удалены):

type
  IDataTransfer = interface;

  PUserType1 = ^_TreeItemRec; {*}
  PSYSINT1 = ^SYSINT; {*}
  PWideString1 = ^PWideChar; {*}
  
  _TreeItemRec = packed record
    ItemName: PChar;
    Sibling: PUserType1;
    Child: PUserType1;
  end;

  IDataTransfer = interface(IUnknown)
    ['{66CD4649-96EC-4DC8-8E87-FE9303AB6BC8}']

    function GetStringLengths(
        out Count: SYSINT;
        out StringLengths: PSYSINT1
      ): HResult; stdcall;

    function GetStrings(
        Count: SYSINT;
        var Numbers: SYSINT;
        out Strings: PWideString1
      ): HResult; stdcall;

    function GetTreeData(
        out Root: PUserType1
      ): HResult; stdcall;

  end;

Во-первых, мы видим, что типам даны очень некрасивые имена. Отредактируем их. Выкинем тип PSYSINT1, так как в модуле ActiveX уже есть тип PSYSINT, являющийся указателем на SYSINT (а SYSINT — это Integer). Далее, в названии типа _TreeItemRec заменим черту стандартным префиксом T, а тип PUserType1 переименуем в PTreeItemRec.

Следующее, что нас не устраивает -это тип PWideString1 параметра Strings того же метода, т.к. этот тип объявлен как указатель на WideString. Но WideString, как мы помним, автоматически финализируется. А реально параметр Strings указывает не на одну строку TBStr, а на массив таких строк, размер которого Delphi не известен, поэтому всё равно придётся освобождать память вручную. Это будет проще сделать, если вообще избавиться от WideString и объявить Strings указателем на TBStr. Такой тип — PBStr — тоже уже описан в модуле ActiveX, поэтому объявление PWideString со спокойной душой выкидываем, а тип параметра Strings заменяем на PBStr. Теперь освобождение памяти, выделенной для строк, полностью в наших руках.

Заодно напишем имена типов в более привычном для Delphi "верблюжьем" регистре, т.е. с выделением начала частей большой буквой.

Также можно выкинуть предварительное объявление интерфейса IDataTranser — в нашем случае оно не нужно.

Осталась одна проблема: неправильно описан параметр Numbers функции GetStrings. Если мы сравним его с IDL-описанием, то вспомним, что это входной параметр, указатель на начало целочисленного массива. Но Delphi сделала из него параметр-переменную целого типа. На двоичном уровне всё правильно: в стек так и так кладётся указатель на целое. Но в таком виде с этим параметром неудобно работать, поэтому мы выкидываем var и меняем его тип с SysInt на PSysInt.

В результате всех этих замен код приобретает следующий вид:

type
  PTreeItemRec = ^TTreeItemRec; {*}

  TTreeItemRec = packed record
    ItemName: PChar;
    Sibling: PTreeItemRec;
    Child: PTreeItemRec;
  end;

  IDataTransfer = interface(IUnknown)
    ['{66CD4649-96EC-4DC8-8E87-FE9303AB6BC8}']

    function GetStringLengths(
        out Count: SysInt;
        out StringLengths: PSysInt
      ): HResult; stdcall;

    function GetStrings(
        Count: SysInt;
        Numbers: PSysInt;
        out Strings: PBStr
      ): HResult; stdcall;

    function GetTreeData(
        out Root: PTreeItemRec
      ): HResult; stdcall;
  end;

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

Следующим шагом будет добавление в проект COM-объекта сервера. Для этого открываем окно New Items через меню File\New\Other, выбираем иконку COM Object, нажимаем OK. Появляется знакомый нам по уроку 9 эксперт. В поле Class name водим имя кокласса (для примера — DataTransfer), в поле Instancing оставляем выбранный по умолчанию вариант Multiple Instance. В поле Threading Model по умолчанию выбрана модель Apartment, но в данном случае она нам не подходит, так как все экземпляры нашего кокласса будут обращаться к VCL-объектам, а значит, должны работать в главной нити. Поэтому в этом поле выбираем нитевую модель Single. В поле Description можно ввести произвольное описание на своё усмотрение или ничего не вводить. И надо обязательно снять галочку Include Type Library, потому что наш сервер не будет использовать библиотеку типов для маршалинга. Все остальные не упомянутые здесь поля после этого станут недоступны. Закрываем окно нажатием OK. К проекту добавляется новый модуль, содержащий заготовку кокласса.

Данная заготовка (класс TDataTransfer) унаследована от TComObject и пока не реализует никаких интерфейсов, кроме IUnknown. В список uses добавляем модуль DataTransfer_TLB и модифицируем класс TDataTransfer так, чтобы он выглядел следующим образом:

TDataTransfer = class(TComObject, IDataTransfer)
  protected
    function GetStringLengths(out Count: SysInt; out StringLengths: PSysInt): HResult; stdcall;
    function GetStrings(Count: SysInt; Numbers: PSysInt; out Strings: PBStr): HResult; stdcall;
    function GetTreeData(out Root: PTreeItemRec): HResult; stdcall;
  end;

Дальше всё, как в любом другом сервере — требуется реализовать методы. Сразу отметим, что для реализации всех методов в список uses придётся добавить модули SysUtils и ComCtrls. Начнём с самого простого метода — GetStringLengths.

function TDataTransfer.GetStringLengths(out Count: SysInt; out StringLengths: PSysInt): HResult;
var
  I: Integer;
  P: PSysInt;
begin
  // В выходной параметр Count заносим количество строк
  Count := ServerForm.Memo.Lines.Count;
  // Выделяем место для массива номеров строк
  StringLengths := CoTaskMemAlloc(SizeOf(SysInt) * Count);
  // Если не получилось, завершаемся с ошибкой
  if StringLengths = nil then
  begin
    Result := E_OutOfMemory;
    Exit
  end;
  // P - указатель на текущий элемент массива StringLengths.
  // Перед циклом устанавливаем его на начало массива
  P := StringLengths;
  for I := 0 to Count-1 do
  begin
    // Заносим в текущий элемент длину строки
    P^ := Length(ServerForm.Memo.Lines[I]);
    // Переходим к следующему элементу
    Inc(P)
  end;
  Result := S_OK
end;

Код метода достаточно понятен. Возможно, небольшого комментария заслуживает способ доступа к элементам массива. Мы имеем указатель, который можно рассматривать как указатель на весь массив или на его первый элемент. В C++ в подобной ситуации используется возможность обращаться с указателем как с массивом, т.е. задавать индекс элемента. В Delphi для этого пришлось бы объявлять отдельный тип — указатель на массив — и приводить к нему имеющийся указатель. Мы решили пойти здесь и далее более естественным для Паскаля путём — использовать указатель на отдельный элемент, который будет смещаться на каждой итерации цикла. Разыменовывая этот указатель, получаем доступ к очередному элементу массива.

Следующий метод, который мы напишем, GetStrings, несколько сложнее для понимания. Во-первых, он должен выполнить больше действий, а во-вторых, он много раз выделяет память, и так как нехватка памяти может случиться в любой момент, должен правильно освободить всю выделенную ранее память (напоминаем, что клиент освобождаем память, выделенную сервером, только в случае успешного завершения метода; в случае ошибки сервер должен освободить всё сам, а всем выходным указателям присвоить nil). Код проверки и освобождения памяти оказывается довольно громоздким и сложным для чтения, поэтому мы здесь сначала рассмотрим его "черновик" — вариант функции, написанный так, будто памяти не может не хватать, т.е. без всяких проверок. После того, как мы на этом упрощённом коде поймём, какие основные операции должен здесь выполнить сервер, перейдём к рассмотрению полноценного кода.

// "Черновик" метода IDataTransfer.GetStrings.
// В нём отсутствуют проверки того, что выделение памяти прошло успешно.
// По этому черновику легче отследить и понять основные действия метода.
// В реальности должен использоваться "чистовой" метод со всеми
// необходимыми проверками.
function TDataTransfer.GetStrings(Count: SysInt; Numbers: PSysInt; out Strings: PBStr): HResult;
var
  CurNum: PSysInt;  // Указатель на текущий элемент массива Numbers
  CurStr: PBStr;  // Указатель на текущий элемент массива Strings
  I: Integer;
begin
  // Выделяем память для массива Strings
  Strings := CoTaskMemAlloc(SizeOf(TBStr) * Count);
  // Устанавливаем указатели на начало массивов
  CurNum := Numbers;
  CurStr := Strings;
  for I := 0 to Count - 1 do
  begin
    // Проверяем, что индекс попадает в допустимый диапазон
    if (CurNum^ >= 0) and (CurNum^ < ServerForm.Memo.Lines.Count) then
      // Выделяем новую строку, копируя в неё данные из строки Memo
      CurStr^ := SysAllocString(PWideChar(WideString(ServerForm.Memo.Lines[CurNum^])))
    else
      CurStr^ := nil;
    // Смещаем указатели на следующий элемент массива
    Inc(CurNum);
    Inc(CurStr)
  end;
  Result := S_OK
end;

Данный метод тоже пока не выглядит сложным. Сначала выделяется требуемое количество памяти для массива строк. Здесь у нас строки TBStr, т.е. реально в массиве хранятся только указатели, память для строк надо выделять отдельно с помощью функции SysAllocString. Кроме того, нужно не забыть перевести имеющуюся у нас в Memo строку из кодировки ANSI в Unicode. Здесь мы делаем это следующим образом. Сначала приводим строку к типу WideString. Компилятор при этом сам осуществляет перекодировку, затем эту строку передаём в функцию SysAllocString, которая выделяет для неё память и копирует содержимое строки туда.

Примечание: Вообще говоря, при приведении типа строки к WideString уже выделена неявно память, и вызывая SysAllocString явно, мы заставляем программу делать двойную работу. Но проблема в том, что созданную при приведении типов строку компилятор считает нуждающейся в финализации после завершения работы метода, а нам нужно, чтобы строка была доступна клиенту. Конечно, можно было бы заставить компилятор "забыть" о том, что он выделил память для этой строки, и сохранить её после завершения метода для клиента. Но это потребовало бы низкоуровневых операций с указателями, а их лучше не использовать, если не знаешь абсолютно точно, что и как нужно делать. Те люди, которые это знают, при желании без труда модифицируют приведённый здесь код, а остальных мы не будем вводить в искушение всякими хакерскими фокусами.

Теперь можно знакомиться и с чистовым вариантом метода

function TDataTransfer.GetStrings(Count: SysInt; Numbers: PSysInt; out Strings: PBStr): HResult;
var
  CurNum: PSysInt;  // Указатель на текущий элемент массива Numbers
  CurStr: PBStr;  // Указатель на текущий элемент массива Strings
  I, J, L: Integer;
begin
  // Выделяем память для массива Strings
  Strings := CoTaskMemAlloc(SizeOf(TBStr) * Count);
  // Проверяем, что память была выделена
  if Strings = nil then
  begin
    // Если нет, возвращаем ошибку
    Result := E_OutOfMemory;
    Exit
  end;
  // Устанавливаем указатели на начало массивов
  CurNum := Numbers;
  CurStr := Strings;
  for I := 0 to Count - 1 do
  begin
    // Проверяем, что индекс попадает в допустимый диапазон
    if (CurNum^ >= 0) and (CurNum^ < ServerForm.Memo.Lines.Count) then
    begin
      // Запоминаем длину строки, чтобы несколько раз её не вычислять заново
      L := Length(ServerForm.Memo.Lines[CurNum^]);
      // Выделяем память для строки
      CurStr^ := SysAllocStringLen(nil, L);
      // Проверяем, что память выделена
      if CurStr^ = nil then
      begin
        // Если не выделена, надо освободить то, что уже успели выделить
        CurStr := Strings;
        // Освобождаем указатели на предыдущие строки массива
        for J := 0 to I - 1 do
        begin
          SysFreeString(CurStr^);
          Inc(CurStr)
        end;
        // Освобождаем массив и обнуляем указатель на него
        CoTaskMemFree(Strings);
        Strings := nil;
        // Возвращаем ошибку
        Result := E_OutOfMemory;
        Exit
      end;
      // Если строка не пустая, преобразуем её в Unicode
      // и заносим в выделенную память
      if L > 0 then
        StringToWideChar(ServerForm.Memo.Lines[CurNum^], CurStr^, L + 1)
    end
    else
      CurStr^ := nil;
    // Смещаем указатели на следующий элемент массива
    Inc(CurNum);
    Inc(CurStr)
  end;
  Result := S_OK
end;

Эта реализация отличается от предыдущей не только тем, что сюда добавлена проверка успешности выделения памяти и её очистка. Теперь мы по-другому преобразуем строку из ANSI в Unicode: сначала выделяем память с помощью SysAllocStringLen, а потом выполняем преобразование с помощью функции StringToWideChar. Сделано это для того, чтобы избавиться от приведения к WideString и связанного с этим неявного выделения памяти, так как при этом тоже может возникнуть ошибка. Эта ошибка проявила бы себя в виде исключения EOutOfMemory, и обработка этого исключения потребовала бы слишком много дополнительного кода. Проще конвертировать строку вручную.

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

Примечание: Не надо рассматривать написание черновика как нормальный способ реализации методов COM-объекта. Если вы выделяете память, то сразу позаботьтесь о контроле ошибок и её освобождении в случае необходимости. А если вставлять эти проверки потом, велика вероятность, что что-нибудь забудете. В частности, приводимые здесь "черновики" делались уже после того, как были испытаны и отлажены чистовики, и нужны только для того, чтобы при первом знакомстве читатель мог не отвлекаться на проверки, а сразу увидел "костяк" метода.

Теперь переходим к последнему методу интерфейса, GetTreeData. Он должен возвращать дерево (точнее, указатель на корневой элемент дерева), а древовидные структуры проще всего обрабатывать рекурсивными функциями. Поэтому в нашем классе появится рекурсивный метод ProcessNode, который будет выделять память для очередного элемента дерева, копировать туда строку из элемента TreeView, и вызывать себя рекурсивно для дочернего узла и следующего узла данного уровня. Возвращать метод будет указатель на созданный элемент или nil, если памяти на его создание не хватило. Мы опять начнём здесь с черновика, который не знает, что памяти может не хватать.

// "Черновик" метода ProcessNode.
// В нём отсутствуют проверки того, что выделение памяти прошло успешно.
// По этому черновику легче отследить и понять основные действия метода.
// В реальности должен использоваться "чистовой" метод со всеми
// необходимыми проверками.
function TDataTransfer.ProcessNode(Node: TTreeNode): PTreeItemRec;
begin
  // Выделяем память под новый элемент дерева
  Result := CoTaskMemAlloc(SizeOf(TTreeItemRec));
  // Выделяем память под название элемента дерева
  Result.ItemName := CoTaskMemAlloc(SizeOf(Char) * (Length(Node.Text) + 1));
  // Копируем название элемента
  StrPCopy(Result.ItemName, Node.Text);
  // Если есть ещё элементы этого же уровня,
  // вызываем себя рекурсивно для формирования ветки Sibling
  if Node.GetNextSibling <> nil then
    Result.Sibling := ProcessNode(Node.GetNextSibling)
  else
    Result.Sibling := nil;
  // Если есть ещё дочерние элементы,
  // вызываем себя рекурсивно для формирования ветки Child
  if Node.HasChildren then
    Result.Child := ProcessNode(Node.Item[0])
  else
    Result.Child := nil
end;

function TDataTransfer.GetTreeData(out Root: PTreeItemRec): HResult; stdcall;
begin
  if ServerForm.TreeView.Items.Count > 0 then
  begin
    Root := ProcessNode(ServerForm.TreeView.Items[0]);
    if Root = nil then
      Result := E_OutOfMemory
    else
      Result := S_OK
  end
  else
  begin
    Root := nil;
    Result := S_OK
  end
end;

Здесь мы работаем со строками другого вида, не TBStr, управление памятью для которых полностью берём на себя. Поэтому выделяем память не функцией SysAllocString, а CoTaskMemAlloc. Для таких строк мы можем использовать любую кодировку, и мы используем здесь ANSI, поэтому никакие дополнительные преобразования не нужны, имеющаяся строка просто копируется в нужный блок памяти.

Метод GetTreeData проверяет результат метода ProcessNode на равенство nil. Из кода ProcessNode видно, что возврат такого значения пока не предусмотрен, это заготовка для "чистового" метода ProcessNode, который будет возвращать nil при ошибке выделения памяти. Эта ошибка, в принципе, может возникнуть при обработке любого элемента дерева, и при её возникновении надо очистить ту часть дерева, которая уже создана. Рассмотрим ситуацию, когда очередная активация метода ProcessNode получила ненулевой указатель для ветки Sibling, а затем — nil для ветки Child. Это значит, что надо очистить ветку Sibling. Для этого понадобится ещё один рекурсивный метод — Delete Item. Сам метод GetTreeData для "чистового" варианта модифицировать не нужно, он уже имеет правильный вид. В итоге чистовой вариант метода ProcessNode будет выглядеть так:

procedure TDataTransfer.DeleteItem(Item: PTreeItemRec);
begin
  if Item <> nil then
  begin
    CoTaskMemFree(Item.ItemName);
    DeleteItem(Item.Child);
    DeleteItem(Item.Sibling);
    CoTaskMemFree(Item)
  end
end;

function TDataTransfer.ProcessNode(Node: TTreeNode): PTreeItemRec;
begin
  // Выделяем память под новый элемент дерева
  Result := CoTaskMemAlloc(SizeOf(TTreeItemRec));
  // Если память не выделена, завершаем работу
  if Result = nil then
    Exit;
  // Выделяем память под название элемента дерева
  Result.ItemName := CoTaskMemAlloc(SizeOf(Char) * (Length(Node.Text) + 1));
  // Если память не выделена, завершаем работу
  if Result.ItemName = nil then
  begin
    // Освобождаем память, выделенную ранее на запись
    CoTaskMemFree(Result);
    Result := nil;
    Exit
  end;
  // Копируем название элемента
  StrPCopy(Result.ItemName, Node.Text);
  // Если есть ещё элементы этого же уровня,
  // вызываем себя рекурсивно для формирования ветки Sibling
  if Node.GetNextSibling <> nil then
  begin
    Result.Sibling := ProcessNode(Node.GetNextSibling);
    // Если память не выделена, завершаем работу
    if Result.Sibling = nil then
    begin
      // Освобождаем память, выделенную ранее на название элемента
      CoTaskMemFree(Result.ItemName);
      // Освобождаем память, выделенную ранее на запись
      CoTaskMemFree(Result);
      Result := nil;
      Exit
    end
  end
  else
    Result.Sibling := nil;
  // Если есть ещё дочерние элементы,
  // вызываем себя рекурсивно для формирования ветки Child
  if Node.HasChildren then
  begin
    Result.Child := ProcessNode(Node.Item[0]);
    // Если память не выделена, завершаем работу
    if Result.Child = nil then
    begin
      // Освобождаем память, выделенную на ветку Sibling
      DeleteItem(Result.Sibling);
      // Освобождаем память, выделенную ранее на название элемента
      CoTaskMemFree(Result.ItemName);
      // Освобождаем память, выделенную ранее на запись
      CoTaskMemFree(Result);
      Result := nil;
      Exit
    end
  end
  else
    Result.Child := nil
end;

Теперь создание сервера полностью завершено. Следует его откомпилировать, зарегистрировать, и можно подключаться к нему клиентом. Который, впрочем, ещё только предстоит написать. Интерфейс этого клиента показан на рисунке 2. В левой части расположено дерево, полученное от сервера при нажатии кнопки "Получить дерево". В середине находится список длин строк, который клиент получает от сервера при нажатии кнопки "Получить длины". Этот список содержит галочки, с помощью которых пользователь может отметить интересующие его строки и получить их в поле Memo (правая часть окна) по нажатию кнопки "Получить строки".


Рисунок 2. Интерфейс клиента

Если бы мы честно делали клиент для сервера, написанного кем-то другим, мы бы получили от разработчика либо готовую библиотеку типов, либо IDL-файл, из которого можно получить эту библиотеку. Затем открыли бы эту библиотеку в среде и получили бы описание интерфейсов на Delphi. Но так как мы это всё уже сделали при написании сервера, то просто копируем файл DataTransfer_TLB.pas в папку клиента и добавляем его в список uses модуля главной формы клиента. Ещё надо из модуля кокласса скопировать объявление константы Class_DataTransfer, содержащий CLSID (этот идентификатор мы бы узнали, например, из документации на сервер). Размещение элементов на форме клиента выполняется обычным образом. Заводим поле DataTransfer типа IDataTransfer, в обработчик события формы OnShow вставляем код, создающий COM-объект и получающий указатель на него, например, с помощью CreateComObject (не забываем добавить в список uses модули ComObj и ActiveX).

После этого начинаем писать код обработчиков нажатий кнопок, в которых и будет упрятан весь код взаимодействия сервера с клиентом. Начнём с кнопки "Получить длины", по которой клиент должен получить от сервера массив длин строк и показать эти длины в элементе управления ChkListLengths: TCheckListBox. Сразу отметим, что здесь уже не будет никаких "черновиков", так как код клиента обязан освобождать выделенную память в любом случае.

// Получаем длины строк
procedure TFormClient.BtnGetLengthsClick(Sender: TObject);
var
  I, Count: SysInt;
  Lengths, CurLen: PSysInt;
begin
  if Assigned(DataTransfer) then
  begin
    OleCheck(DataTransfer.GetStringLengths(Count, Lengths));
    // Блок try..finally нужен для того, чтобы в любом случае
    // освободить память, выделенную сервером
    try
      ChkListLengths.Clear;
      // CurLen - указатель на текущий элемент массива Lengths
      CurLen := Lengths;
      for I := 0 to Count - 1 do
      begin
        // Добавляем строку
        ChkListLengths.Items.Add(IntToStr(I + 1) + ': ' + IntToStr(CurLen^));
        // Переходим к следующему элементу
        Inc(CurLen)
      end
    finally
      // Освобождаем память, выделенную сервером под массив Lengths
      CoTaskMemFree(Lengths)
    end
  end
end;

Здесь мы применяем тот же способ перебора элементов массива через указатель, что и в сервере. В остальном код метода прост и в комментариях не нуждается.

Следующий обработчик — обработчик нажатия кнопки "Получить строки". По нажатию этой кнопки клиент должен передать серверу номера строк, отмеченные пользователем в ChkListLengths, и получить от сервера список строк в ответ, которые будут отображены в Memo.

// Получение строк
procedure TFormClient.BtnGetStringsClick(Sender: TObject);
var
  I, Count: SysInt;
  Numbers, CurNum: PSysInt;
  Strings, CurStr: PBStr;
begin
  if Assigned(DataTransfer) then
  begin
    // В цикле считаем количество строк, у которых пользователь
    // поставил галочки
    Count := 0;
    for I := 0 to ChkListLengths.Items.Count - 1 do
      if ChkListLengths.Checked[I] then
        Inc(Count);
    if Count = 0 then
    begin
      Application.MessageBox('Не отмечена ни одна строка, вызов невозможен', 'Ошибка');
      Exit
    end;
    // Выделяем память для массива номеров строк
    Numbers := CoTaskMemAlloc(SizeOf(SysInt) * Count);
    if Numbers = nil then
    begin
      Application.MessageBox('Не хватает памяти для массива длин', 'Ошибка');
      Exit
    end;
    // Блок try..finally нужен, чтобы гарантировано
    // освободить память, выделенную под массив Numbers
    try
      // CurNum - указатель на текущий элемент массива Numbers
      CurNum := Numbers;
      // Проходим в цикле все строки CheckListBox'а, и,
      // если поставлена галочка, заносим номер в массив Numbers
      for I := 0 to ChkListLengths.Items.Count - 1 do
        if ChkListLengths.Checked[I] then
        begin
          CurNum^ := I;
          Inc(CurNum)
        end;
      // Вызываем функцию сервера
      OleCheck(DataTransfer.GetStrings(Count, Numbers, Strings));
      try
        Memo.Clear;
        // CurStr - указатель на текущий элемент массива Strings
        CurStr := Strings;
        // CurNum - указатель на текущий элемент массива Numbers
        CurNum := Numbers;
        // Добавляем строки в Memo
        for I := 0 to Count - 1 do
        begin
          if CurStr^ = nil then
            Memo.Lines.Add('Ошибка при получении строки ' + IntToStr(CurNum^ + 1))
          else
            Memo.Lines.Add('Строка ' + IntToStr(CurNum^ + 1) + ': ' + CurStr^);
          // смещаем указатели
          Inc(CurNum);
          Inc(CurStr)
        end
      finally
        // Очищаем память, выделенную сервером
        CurStr := Strings;
        // Сначала удаляем все строки
        for I := 0 to Count - 1 do
        begin
          SysFreeString(CurStr^);
          Inc(CurStr)
        end;
        // Потом - сам массив
        CoTaskMemFree(Strings)
      end
    finally
      // Очищаем память, выделенную клиентом
      CoTaskMemFree(Numbers)
    end
  end
end;

Сначала надо определить количество элементов, выделенных пользователем. Затем — выделить память для массива, в который мы эти номера поместим, и скопировать их. Код вызова метода и заполнения Memo достаточно прост, если строка имеет значение nil, то, как мы договаривались раньше, это означает, что строки с таким номером у сервера нет. После этого очищаем память: сначала для каждой строки по отдельности, затем — для всего массива указателей на строку, и потом, конечно же, для массива номеров строк, созданного самим клиентом — за его очистку тоже несём ответственность мы.

Примечание: На первый взгляд может показаться, что при таком пользовательском интерфейсе мы никогда не получим nil в строке — ChkListLengths просто не даст нам выбрать строку с несуществующим номером. На самом деле получить эту ситуацию очень просто: нажать кнопку "Получить длины", отметить несколько последних строк, переключиться на сервер и удалить там в Memo несколько строк, вернуться в клиент и, не получая длины строк заново, нажать кнопку "Получить строки". Так как теперь у сервера стало меньше строк, для последних строк он вернёт nil.

Нам остался обработчик последней кнопки "Получить дерево". Как обычно при работе с деревом, понадобятся рекурсивные методы. В данном случае их будет два: ProcessItem для добавления в дерево очередного элемента и ClearItem для освобождения памяти, выделенной сервером для элемента, а заодно и для всех элементов, на которые он ссылается через Sibling и Child.

// Рекурсивная процедура, создающая элемент в дереве
procedure TFormClient.ProcessItem(ParentNode: TTreeNode; Item: PTreeItemRec);
var
  NewNode: TTreeNode;
begin
  if Assigned(Item) then
  begin
    NewNode := TreeView.Items.AddChild(ParentNode, Item.ItemName);
    ProcessItem(ParentNode, Item.Sibling);
    ProcessItem(NewNode, Item.Child)
  end
end;

// Рекурсивная процедура, освобождающая память,
// выделенную сервером для элемента дерева
procedure TFormClient.ClearItem(Item: PTreeItemRec);
begin
  if Assigned(Item) then
  begin
    CoTaskMemFree(Item.ItemName);
    ClearItem(Item.Sibling);
    ClearItem(Item.Child);
    CoTaskMemFree(Item)
  end
end;

procedure TFormClient.BtnGetTreeClick(Sender: TObject);
var
  Root: PTreeItemRec;
begin
  if Assigned(DataTransfer) then
  begin
    TreeView.Items.Clear;
    // Вызываем функцию сервера
    OleCheck(DataTransfer.GetTreeData(Root));
    try
      // Заполняем дерево
      ProcessItem(nil, Root)
    finally
      // Очищаем память, выделенную сервером
      ClearItem(Root)
    end
  end
end;

Код прост и понятен, единственный момент, требующий комментария — это то, зачем понадобилось два обхода дерева, почему нельзя было освобождать память непосредственно в ProcessItem, ведь там это достаточно легко было бы сделать. Второй обход нужен потому, что при первом обходе выше вероятность исключения, и если оно возникнет, гарантировать освобождение всей памяти будет сложно. Второй обход не делает ничего кроме освобождения памяти, в нём сбой может возникнуть только при катастрофической ошибке, поэтому освобождение памяти в таком случае практически гарантировано, а потеря эффективности на фоне таких затратных процессов как вызов через границы процесса и перераспределение памяти практически незаметна.

На этом создание клиента завершено, его можно подключать к серверу и тестировать. Отметим, что описанная здесь методика создания proxy/stub dll будет использоваться нами в дальнейшем всякий раз, когда мы будим рассматривать такие аспекты технологии COM, которые могут быть продемонстрированы только с использованием стандартного маршалинга.

Как и сервер с библиотекой типов, данный сервер может работать удалённо. Для этого на машине клиента и сервера достаточно зарегистрировать proxy/stub dll и выполнить те же действия по настройке DCOM, что и для сервера с библиотекой типов.

Код, работающий с массивами, получился несколько сложнее, чем в сервере с библиотекой типов и клиенте к нему. Это связано, разумеется, с тем, что ранее мы использовали относительно высокоуровневые безопасные массивы, а здесь работали с указателями на низком уровне. Но зато мы получили, во-первых, дополнительные возможности по использованию сложных структур, а во-вторых, более высокое быстродействие. В качестве примера можно привести стандарт OPC (OLE for Process Control). Этот стандарт описывает набор интерфейсов для обмена динамическими данными в верхнем уровне автоматизированных систем. Различные массивы в нём передаются достаточно часто. Первоначально стандарт OPC планировалось построить на дуальных интерфейсах, использующих универсальный маршалинг и VARIANT-совместимые типы. Но потом оказалось, что это существенно снижает быстродействие, поэтому стандарт был реализован на обычных интерфейсах с использованием стандартного маршалинга, а для тех клиентов, которые не поддерживали такие интерфейсы, была предусмотрена библиотека-переходник. Это позволило существенно поднять скорость хотя бы для тех клиентов, которые могли пользоваться обычными интерфейсами без переходников.

Примеры к уроку


предыдущий урок содержание семинара  




Смотрите также материалы по темам:
[Технологии ActiveX, COM, DCOM] [COM-сервер]

 Обсуждение материала нет сообщений
  
Время на сайте: GMT минус 5 часов

Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter.
Функция может не работать в некоторых версиях броузеров.

Web hosting for this web site provided by DotNetPark (ASP.NET, SharePoint, MS SQL hosting)  
Software for IIS, Hyper-V, MS SQL. Tools for Windows server administrators. Server migration utilities  

 
© При использовании любых материалов «Королевства Delphi» необходимо указывать источник информации. Перепечатка авторских статей возможна только при согласии всех авторов и администрации сайта.
Все используемые на сайте торговые марки являются собственностью их производителей.

Яндекс цитирования