    ГЛАВА       19 

    Работа с интерфейсами СОМ _ 

    Тодд Миллер 


    --- Основы архитектуры СОМ (Component Object Model) 

    Обсуждаются основные архитектуры СОМ. 

    --- Интерфейсы Delphi 

    Новое расширение языка inter- ' face, поддерживаемое Delphi, значительно 
упрощает работу с объектами и интерфейсами СОМ. 

    -- Серверы объектов СОМ 

    Здесь рассматриваются способы создания и регистрации серверов объектов СОМ 
и методы получения доступа к серверам из приложений-клиентов. 

    -- Расширения оболочки Windows 

    Изучите методы разработки объектов - расширений оболочки Windows 95 и 
Windows NT 4. 

    В этой главе описаны методы работы с составными объектами и интерфейсами 
СОМ в Delphi 3. Вначале изложены основы архитектуры Component Object Model 
(СОМ). Затем речь идет о серверах и клиентах составных объектов. После 
ознакомления с основами архитектуры СОМ читателю предлагается создать простой 
сервер объектов СОМ. Чтобы дать более полное представление о рассматриваемом 
предмете, сервер объектов СОМ сначала создается с помощью методов 
программирования, используемых в Delphi 2, а затем демонстрируется простота и 
легкость создания этого же сервера с помощью методов программирования, 
реализованных в Delphi 3. И в завершение главы представлены методы создания 
расширений для оболочки Windows. Эта глава поможет понять, что собой 
представляет архитектура СОМ. 

    Основы архитектуры СОМ 

    Модель СОМ, или Component Object Model, является независимой от языка 
программирования спецификацией, которая базируется на объектах. Эта 
спецификация определяет  способ   построения   составных   объектов {Component 
Objects) и способ предоставления доступа к составным объектам. Приведенные 
ниже определения помогут вам разобраться и архитектуре и основнык^очцеп- ,:„ 
циях модели СОМ. 
    Составной объект (component object}— это одна или несколько служб (или 
интерфейсов), которые предоставляются пользователю для обеспечения 
дополнительной функциональности. Составные объекты можно представить себе как 
объекты C++, полученные посредством множественного наслс

    438 

    дования нескольких классов C++. Составной объект может бытьдростым, как 
расширения оболочки Windows 95, предоставляющие пользователям один или два 
интерфейса, и сложным, как элемент управления ActiveX, который использует 
множество интерфейсов для прямой и обратной связи с клиентским приложением. 
    •I Интерфейс — это определение объекта и сам объект. По сути, интерфейс 
является исключительно виртуальным классом, определяющим методы, которые будут 
реализованы в интерфейсном объекте. Каждому интерфейсу присваивается 
уникальный идентификатор, следовательно, можно точно определить, интерфейс к 
какому составному объекту клиент запрашивает у сервера. 
    • Интерфейсный объект — это реализация одного или нескольких интерфейсов 
объекта. Еще раз: составной объект может предоставлять клиентам несколько 
интерфейсов, следовательно, для каждого интерфейса должен существовать 
реализующий его интерфейсный объект. 
    В общем, составной объект предоставляет клиенту функциональное решение на 
основе одного или нескольких интерфейсов, которые поддерживает объект. Каждая 
служба (или интерфейсный объект) доступна пользователю через соответствующий 
интерфейс, как будет показано ниже. 

    Что такое клиенты и серверы 

    Где расположен составной объект и как клиенты получают к нему доступ? 
Составные объекты находятся внутри сервера СОМ, который может быть либо 
динамической библиотекой (DLL), либо приложением (ЕХЕ). Серверы, выполненные в 
виде динамических библиотек, называются внутренними (in-process). А серверы, 
реализованные в приложениях, называют локольиьшк серверами СОМ. Основное 
различие между названными типами серверов состоит в том, что в отличие от 
локального сервера, функционирующего в собственном адресном пространстве, 
внутренний сервер загружается непосредственно в адресное пространство 
клиентского процесса. no^ro^nJiH'iiiHfi.JiQKaJibHbie серверы иногда называют 
внешними. Существует также понятие удалённого (remote) сервера СОМ. Удаленным 
считают сервер, который выполняется шГдругом по отношению к клиенту 
компьютере. Причем оба компьютера должны поддерживать технологию DCOM (более 
детальная информация о DCOM изложена ниже). 
    Для ссылок на различные типы серверов СОМ компания Microsoft ввела новый 
термин — ActiveX. Он используется для ссылок на OLE, элементы управления 
ActiveX и активные документы. Существует еще один термин, связанный с термином 
ActiveX, — DirectX. С его помощью ссылаются на множество новых интерфейсов 
СОМ, предназначенных для прямого доступа к различным устройствам вашего 
компьютера, таким как звуковая или видеоплата. 

    Клиенты составных объектов 

    Клиентами составных объектов обычно являются приложения, но иногда ими 
могут быть и динамические библиотеки. Это зависит от назначения составного 
объекта. В случае с расширениями оболочки Windows клиентом является сама 
система Windows, или, если быть точным, — оболочка Windows (Explorer.exe). 
Кроме того, клиенты обычно работают в отдельном от сервера СОМ адресном 
пространстве. Другими словами, клиенты "не знают" где находится сервер СОМ и 
как его запустить. Им лишь известно, с каким составным объектом они должны работать. 
    Прежде чем клиент получит доступ к какому-либо составному объекту сервера 
СОМ, нужно выполнить запрос к Windows для поиска выбранного составного 
объекта. В этом случае Windows найдет и запустит соответствующий сервер, после 
чего вернет запрашиваемый интерфейсный объект (который был неявно востребован пользователем). 
    Возникает вопрос: откуда Windows знает, где искать сервер составного 
документа? Эта проблема решается с помощью м|стемногореестра Windows. Система 
просматривает реестр и находит в нем информацию о положении сервера. Это 
означает, что каждый сервер СОМ должен иметь Соответствующие записи в реестре, 
как минимум — запись о положении сервера и способе его загрузки. После 
загрузки сервера Windows прежде всего выясняет, поддерживает ли сервер 
требуемый составной объект. В случае положительного ответа Windows проверяет, 
поддерживает ли сервер запрашиваемый клиентом интерфейс. Если и здесь ответ 
положительный, то ссылка на нужный интерфейс возвращается клиенту, а на 
стороне сервера создается ссылка на связанный интерфейсный объект. 
    Архитектура СОМ применима в рамках одного компьютера. На отдельном 
компьютере можно использовать 4 как внутренние, так и внешние серверы. Тем не 
менее компания Microsoft недавно представила технологию —У Distributed СОМ, 
расширяющую технологию СОМ за пределы одного компьютера. Бета-версия 
распредели ленной (distributed) архитектуры СОМ, или DCOM, впервые была 
представлена в пакете Visual Basic 4 Professional Edition. В этой книге 
используется реализация DCOM, встроенная в Windows NT 4. Единственным 
преимуществом версии, поставляемой с пакетом Visual Basic, является 
возможность ее использования в Windows 95. Другим продуктом, позволяющим 
использовать объекты OLE в рамках сети, является OLE Enterprise. Этот продукт 
создан дочерним предприятием компании Borland фирмой Open Environment. OLE 
Enterprise поддерживает все платформы, на которых функционирует среда Win32. 

    Глава 19. Работа с интерфейсами СОМ                                 439 


    Поиск составных объектов 

    Теперь у читателя может возникнуть вопрос, какую информацию нужно передать 
Windows, чтобы система нашла нужный клиенту составной объект. Системе Windows 
передается уникальный в глобальном смысле идентификатор (globally unique 
identifier), далее— GUID, который связан с составным объектом. Для составных 
объектов идентификатор GUID называют идентификатором класса и для его 
обозначения используют аббревиатуру CLS/D. Кроме идентификатора класса, клиент 
должен передать Windows запрос для получения выбранного интерфейса. Интерфейсы 
также идентифицируются с помощью идентификатора GUID, который в данном случае 
называют идентификатором интерфейса IID. Идентификатор IID ссылается на 
интерфейс объекта СОМ. 
    Заметьте одну интересную особенность: когда клиент запрашивает какой-либо 
интерфейс составного объекта, помещенного в контейнер. Windows возвращает 
клиенту только ссылку на выбранный интерфейс, а не на весь составной объект. 
Составной объект — это просто контейнер интерфейсов или интерфейсных объектов, 
которые реализованы для формирования функциональности составного объекта. 
Клиент должен знать или делать безопасные предположения об интерфейсах, 
которые поддерживает конкретный сервер СОМ. 

    Получение других интерфейсов 

    Возникает естественный вопрос: как клиент может получить другие 
интерфейсы, поддерживаемые составным объектом? Как будет показано далее, 
архитектура СОМ снабжена механизмом, который позволяет клиенту, получившему 
ссылку на один интерфейс, получать или запрашивать ссылки на другие 
поддерживаемые объектом интерфейсы. Другими словами, составной объект похож 
на|брокера интерфейсных объектов— он^е обладает никакими 
интсллектуальными.свойствами,Ыо знает,^акие интерфейсы поддерживает. В 
совокупности интерфейсы объекта точно знают, что можно делать с составным объектом. 

    Какие интерфейсы определены 

    Теперь следует прояснить еще один вопрос: как клиент узнает, какой из 
интерфейсов нужно использовать. Здесь в игру вступает технология OLE. Это 
набор интерфейсов общего назначения, которые используются серверами СОМ для 
определения составных объектов, реализованных сервером. Эти же интерфейсы 
общего назначения используются клиентами для получения доступа к интерфейсным 
объектам составного объекта. 
    Например, интерфейс IDataObject используется во многих случаях для 
передачи данных от сервера OLE/COM клиенту. Он будет использоваться в примере 
расширения оболочки Windows в этой главе. Стандартные интерфейсы OLE можно 
расширять, порождая от них новые интерфейсы. Можно также создавать новые 
интерфейсы, если ни один интерфейс не соответствует нуждам разработчика. При 
работе с нестандартными интерфейсами в большинстве случаев требуется упаковать 
и преобразовать данные (marshaling), чтобы предоставить Windows информацию о 
способах использования созданных" интерфейсов. Более подробная информация об 
упаковке и преобразовании данных приведена ниже. Для стандартных интерфейсов 
QLE-не нужно выполнять упаковку и преобразование данных, так как они 
автоматически выполняются системой Windows. 

    СОМ - бинарный стандарт 

    Рассмотрим, как архитектура СОМ создает каналы коммуникаций между 
процессами. СОМ является бинарным (двоичным) стандартом, который можно 
использовать в любой поддерживающей этот стандарт среде разработки, например в 
Delphi. Бинарный стандарт, используемый в архитектуре СОМ, — это таблица 
виртуальных методов. Виртуальная таблица используется для разрешения вызовов 
методов объектов. Этот механизм ничем не отличается от аналогичного механизма 
таблиц виртуальных методов, используемого в Delphi для реализации 
виртуаЖных"методов классов" С'его помощью были определены интерфейсы СОМ в 
Delphi 2. Тем не менее между интерфейсом СОМ и класс6мТ5е1ргн существует 
различие. Все методы интерфейса СОМ должны быть объявлены как чисто 
виртуальные методы. Поэтому интерфейс СОМ определяет только функциональность, 
которая обеспечивает пользователя информацией о том, как работает интерфейс и 
какие методы можно вызывать после получения указателя на интерфейс. 
    На практике клиентское приложение может получать ссылку на экземпляр 
интерфейса СОМ, который создан другим приложением. Кроме того, клиентское 
приложение знает, как взаимодействовать с интерфейсом, благодаря информации о 
структуре таблицы виртуальных методов. Таким образом, интерфейс СОМ передает 
клиентскому приложению информацию об объекте СОМ. Реальное создание 
интерфейсного объекта выполняется сервером СОМ после получения запроса от 
клиента через подсистему OLE. После этого клиентскому приложению возвращается 
ссылка на требуемый интерфейс. Т\т в игру вступает бинарный стандарт, так как 
для вызова методов объекту необходим только указатель на таблицу виртуальных методов. 

    440                                           Часть V. Работа с OLE 

    • В Delphi чисто виртуальные методы определяются как абстрактный 
виртуальный класс. Пример, показанный ниже, демонстрирует объявление класса 
TPureVirtualClass, в котором содержится два абстрактных виртуальных метода. 

    TPureVirtualClass = class 
    public 
    procedure Methodi; virtual; abstract; 
    function Method2: Longint; virtual; abstract
    end; 

    Назначение абстрактного класса— определить функциональность, которая будет 
реализована в потомках этого класса. 
    В предыдущих версиях Delphi для определения интерфейсов СОМ можно было 
использовать только классы. В этой главе рассмотрим методы использования новой 
инструкции языка Delphi (Interface) для определения интерфейсов СОМ. 
    С помощью механизма, известного как преобразование данных (marshalling), 
клиентские приложения могут получать доступ к объектам СОМ, функционирующим в 
другом процессе или на другом компьютере. Преобразование данных 
предусматривает упаковку параметров, передаваемых методу выбранного объекта, и 
пересылку этой информации в другой процесс или на другой компьютер, где 
полученные данные будут распакованы и будет выполнен вызов метода объекта СОМ. 
Для функционирования средств преобразования данных необходимо, чтобы 
операционная система обладала полной информацией об обслуживаемом интерфейсе. 
Преобразование данных между различными процессами выполняется почти для всех 
стандартных интерфейсов OLE. Такая ситуация сохранится до момента ввода в 
эксплуатацию стандарта DCOM, который позволит выполнять преобразование данных 
между различными компьютерами сети. Процесс преобразования данных при вызове 
методов является самым дорогостоящим в работе с объектами СОМ. Если сервер СОМ 
выполнен в виде динамической библиотеки, то при вызове методов преобразования 
данные не понадобятся, и дополнительные ресурсы будут расходоваться только на 
поиск метода в таблицах виртуальных методов. Из этого правила есть исключения, 
вступающие в силу, когда сервер используют клиенты, допускающие работу в 
многопроцессном (multithreaded) режиме, но эта тема здесь не рассматривается. 

    Что такое подсчет ссылок 

    Другой фундаментальной особенностью архитектуры СОМ является подсчет 
ссылок на интерфейсные объекты. Когда копия интерфейсного объекта создается 
впервые, его внутренний счетчик ссылок устанавливается равным 1. Для каждого 
следующего клиента, получившего ссылку на этот интерфейсный объект, вызывается 
метод AddRef, который увеличивает счетчик ссылок на единицу. И наоборот, когда 
клиент заканчивает работу с интерфейсным объектом, вызывается метод Release, 
который уменьшает на единицу значение счетчика ссылок. При каждом вызове метод 
Release проверяет, не достигло ли нуля значение счетчика ссылок, и, если это 
случилось, метод Release уничтожает интерфейсный объект. 
    Что полезного можно извлечь из подсчета ссылок? В общем, картина такая. 
Предположим, что клиент А запросил у конкретного сервера интерфейс IMalloc. 
Сервер получил запрос и определил, что интерфейсный объект IMalloc еще не 
создан. После этого сервер создает интерфейсный объект IMalloc, вызывает метод 
AddRef для начальной установки единицы в счетчике ссылок созданного объекта и 
возвращает клиенту А ссылку на объект. Пока клиент А работает с ссылкой на 
объект IMalloc, клиент Б выполняет запрос для получения интерфейса IMalloc. 
Сервер СОМ может выполнить один из двух сценариев— создать еще один объект 
IMalloc и передать ссылку на него клиенту Б или после увеличения на единицу 
значения счетчика ссылок существующего объекта IMalloc (с помощью метода 
AddRef) возвратить клиенту Б ссылку на существующий интерфейсный объект. Во 
втором случае, после того как клиент А закончит работу с интерфейсом IMalloc 
(и будет вызван метод Release), интерфейсный объект не будет уничтожен, так 
как значение счетчика ссылок объекта не будет равно нулю (клиент Б все еще 
использует интерфейс Imalloc). Интерфейсный объект IMalloc будет уничтожен, 
когда клиент Б закончит работу с этим интерфейсом. 
    Явное преимущество подсчета ссылок на интерфейсные объекты состоит в том, 
что единственный объект может одновременно обслуживать несколько клиентов. А 
это прямо влияет на объем используемой памяти. Как будет показано ниже, можно 
создавать серверы с одной копией интерфейсного объекта или серверы с 
несколькими копиями интерфейсных объектов, которые для каждого клиента создают 
новый составной объект. 

    Глава 19. Работа с интерфейсами СОМ                                 441 


    Интерфейс (Unknown - прародитель всех интерфейсов 

    Методы AddRef и Release — это два из трех базовых методов, являющихся 
общими для всех интерфейсов СОМ. Третьим методом является Querylnterface. Эти 
три метода и составляют интерфейс lUnknown. Ниже показано определение 
интерфейса lUnknown, используемое в Delphi 2. 

    lUnknown = class 
    public 
    function Querylnterface(const iid: TIID; var obj): HResult; 
    virtual; stdcall; abstract; 
    function AddRef: Longint; virtual; stdcall; abstract; 
    function Release: Longint; virtual; stdcall; abstract; 
    end; 

    Аналогично классу TObject, который является предком всех объектов Delphi, 
интерфейс lUnknown является базовым классом для всех интерфейсов СОМ. Это 
означает, что клиент, получивший ссылку на какой-либо интерфейс, имеет 
гарантированную возможность вызова методов AddRef, Release и Querylnterface. 
Эти три метода определяются временем жизни интерфейсного объекта. В этой главе 
уже рассматривались методы AddRef и Release, теперь речь пойдет о методе Querylnterface. 
    Каждый интерфейсный объект должен иметь возможность ответить на вопрос, 
поддерживаешь ли ты интерфейс Х или можешь ли ты передать мне ссылку на 
интерфейсный объект, который поддерживает этот интерфейс. Именно для ответов 
на такие вопросы был разработан метод Querylnterface. Заметьте, что этот метод 
получает идентификатор интерфейса (IID) и переменную ссылки на объект (Obj). 
Идентификатор интерфейса указывает на требуемый интерфейс, а переменная Obj 
передается для получения ссылки на интерфейсный объект, поддерживающий 
запрашиваемый интерфейс. Если поддерживающего запрашиваемый интерфейс объекта 
не существует, то в переменной Obj возвращается значение Nil. Метод 
Querylnterface обеспечивает клиентские приложения возможностью получения 
необходимого интерфейса, который поддерживается текущим интерфейсным объектом 
или одним из совокупных интерфейсных объектов. Объединение интерфейсов 
(interface aggregation) — это простое объявление двух или более интерфейсов 
для обеспечения необходимой функциональности для выбранного составного 
объекта. Как будет показано далее в этой главе. в Delphi легко реализовать 
объединение интерфейсов, так что не пугайтесь терминов, приведенных выше.      
    И хотя существует еще много теоретической информации, единственный способ 
освоить архитектуру СОМ — закатать рукава и начать кодировать.             
    Чтобы не запутаться в двух модулях, которые оперируют интерфейсами СОМ, 
проясним ситуацию. В Delphi 2.X у все интерфейсы OLE объявлены как абстрактные 
виртуальные классы (подобно интерфейсу lUnknown, о котором говорилось ранее) в 
модуле OLE2. Поскольку в Delphi 3 в язык внесены фундаментальные изменения, 
все интерфейсы OLE были переписаны и перенесены в модуль ACTIVEX. В первом 
примере в этой главе использовались старые интерфейсы Delphi 2, чтобы 
продемонстрировать объем кода, необходимого для реализации сервера СОМ в 
Delphi 2. Далее будут использованы новая инструкция Interface и модуль ACTIVEX. 

    Создание сервера СОМ "с нуля" 

    В данном разделе описано создание сервера СОМ, который содержит составной 
объект, поддерживающий интерфейс IMalloc. Ниже в этой главе, после изучения 
новой инструкции Interface, будет рассказано, как построить такой же сервер с 
интерфейсом IMalloc с помощью новой конструкции языка. Тем не менее этот 
раздел также важен, поскольку в нем продемонстрировано все, что необходимо 
сделать для создания сервера с нуля. Здесь будет рассмотрен каждый этап 
создания сервера с помощью фрагментов кода исходного текста сервера, который 
приведен в конце раздела. Таким образом, читатель не будет перегружен кодом 
большого объема. Изучив отдельные фрагменты кода, вы легко сможете разобраться 
в полном исходном тексте сервера СОМ. 

    Создание составного объекта 

    Первое, в чем нуждается составной объект, — это уникальный идентификатор 
класса, который указывает на объект. В листинге 19.1 CLSID вводится как 
константа Class_MallocComponentObject. Эта константа принадлежит типу TCLSID, 
который определен следующим образом. 

    TCLSID = TGUID; 
    TGUID = record 


    442                                           Часть V. Работа с OLE 


    Dl: Integer; 
    D2: Word; 
    D3: Word; 
    D4: array[0..7] of Byte; 
    end; 

    Назначение полей записи TGUID знать необязательно, но важно помнить, что, 
когда Windows создает GUID, это значение является статистически уникальным. 
Генерация CLSID выполняется один раз для каждого составного объекта, который 
вы создаете. В данном случае в сервере СОМ создается только один составной 
объект, поэтому CLSID нужно генерировать один раз. 
    Затем нужно определить, какие интерфейсы следует реализовать для 
формирования функциональности составного объекта. В нашем случае клиент должен 
получить возможность выделять (allocate), повторно выделять (reallocate) и 
освобождать (free) несколько блоков памяти. Так уж случилось, что существует 
стандартный интерфейс OLE IMalloc, предоставляющий клиентам аналогичную 
функциональность. Интерфейс IMalloc определен в модуле OLE2.PAS, как показано ниже. 

    IMalloc = class(lUnknown) 
    public 
    function Alloc(cb: Longint): Pointer; virtual; stdcall; abstract; 
    function Reallocfpv: Pointer; cb: Longint): Pointer; virtual; stdcall; abstract; 
    procedure Free(pv: Pointer); virtual; stdcall; abstract; 
    function GetSizefpv: Pointer): Longint; virtual; stdcall; abstract
    function DidAlloc(pv: Pointer): Integer; virtual; stdcall; abstract
    procedure HeapMinimize; virtual; stdcall; abstract; 
    end; 

    Полную информацию об интерфейсах OLE можно найти в книге Inside OLE 
(Second Edition, Kraig Brockschmidt, Microsoft Press) 
    Обратите внимание на два момента, имеющих отношение к интерфейсу IMalloc. 
Во-первых, этот интерфейс наследуется от интерфейса lUnknown. Во-вторых, он 
является коллекцией виртуальных абстрактных методов, реализовать которые можно 
позже. Конечно, именно из-за возможности собственной реализации методов и 
используются интерфейсы. Кроме того, используя стандартный интерфейс OLE, 
клиент может быть уверен, что ему будет доступен стандартный набор методов с 
известным поведением. Следовательно, с точки зрения разработчика интерфейса, 
необходимо, чтобы спецификация интерфейса не конфликтовала с предположениями, 
которые сделали клиентские приложения на основе этой же спецификации. В этой 
главе не будет описываться реализация методов интерфейса IMalloc, детали 
реализации этих методов приведены в листинге 19.Г. Тем не менее рассмотрим 
подробнее реализацию методов интерфейса lUnknown. Начнем с методов AddRef и 
Release, код которых показан ниже. 

    TMallocComponentObject = class(IMalloc) private 
    FRefCount: Longint; // Инициализируется значением О; 
    function TMallocComponentObject.AddRef: Longint; 
    begin 
    Inc(FRefCount) ; 
    Inc (Global_Object_Count) ; 
    Result := FRefCount; 
    end; 
    function TMallocComponentObject.Release: Longint; 
    begin 
    Dec(FRefCount) ; 
    Dec(Global_Object_Count) ; 
    Result := FRefCount; 
    //Проверить, используется ли объект еще каким-нибудь клиентом. 
    //Если нет, разрушить объект. 
    if FRefCount = 0 then Destroy; 
    end; 

    Методы AddRef и Release соответственно увеличивают и уменьшают значение 
счетчика ссылок (член FRefCount) объекта TMallocComponentObject. Кроме того, 
после уменьшения значения счетчика ссылок метод Release выполняет проверку 
счетчика ссылок на равенство нулю. Если значение равно нулю, то объект 
уничтожается с помощью метода Destroy. 

    Глава 19. Работа с интерфейсами СОМ                                 443 

    И наконец, все объекты, помещенные на сервер СОМ, увеличивают и уменьшают 
глобальное значение счетчика объектов (переменная Global_Object_Count). В 
данном случае существует только один объект. Переменная Giobal_Object_Count 
используется в функции DllCanUnloadNow, описанной в следующем разделе. 
    Код, показанный в листинге 19.1, можно найти в файле MALLOC1. РАЗ на 
дополнительно распространяемой дискете. 

    Листинг 19.1. \UDELPHl3\CHPl9\MSERVERl\MALLOCl. РАЗ. Исходный код 
реализации интерфейса iMalloc 

    unit Malloci; 
    interface 
    uses Windows, 01e2, SysUtils; 
    const 
    // {OAA17140-310E-11DO-A45E-444553540000} 
    Class_MallocComponentObject: TCLSID = ( 
    D1:$OAA17140; D2:$310E; D3:$11DO; D4:($A4,$5E,$44,$45,$53,$54,$00,$00));  . 
    type 
    TMallocComponentObject = class(IMalloc) 
    private 
    FRefCount: Longint; // Инициализируется значением О; 
    FHeapHandle: THandle; 
    public 
    Constructor Create; 
    Destructor Destroy; override; 
    // Методы интерфейса lUnknown (IMalloc наследует эти методы). 
    function Querylnterface(const IID: TGUID; 
    var Obj): Integer; override; 
    function AddRef: Integer; override; 
    function Release: Integer; override; 
    // Методы интерфейса Imalloc. 
    function Allocfcb: Longint): Pointer; override; 
    function Realloc(pv: Pointer; cb: Longint): Pointer; override; 
    procedure Freetpv: Pointer); override; 
    function GetSize(pv: Pointer): Longint; override; 
    function DidAlloc(pv: Pointer): Integer; override; 
    procedure HeapMinimize; override; 
    end; 
    var Global Object Count: Integer; 
    // Отслеживает объекты, используемые в данный момент. Если 
    // Global Object Count = 0, то ни один составной объект не 
    // используется и DLL можно выгружать из памяти. 
    implementation 
    const 
    // Эта константа не определена в Delphi 3.0; 
    // используется в HeapCreate и т.д. 
    HEAP_ZERO_MEMORY = $00000008; 
    Constructor TMallocComponentObject.Create; 
    //———————————————————————————_——_——————_———————— 
    // Назначение. Запрашивает блок виртуальных адресов 
    // размером 64 Кбайт 
    // и фиксирует 4 Кбайт виртуальной памяти. Сохраняет дескриптор 
    // кучи (heap) в переменной HeapHandle. 


    444                                           Часть V. Работа с OLE 


    // Эта переменная будет использоваться функциями работы с кучей 
    // в других методах. Если HeapHandle =0, то функции работы с кучей 
    // завершатся неудачно. 
    // 
    begin 
    Self.FHeapHandle := Windows.HeapCreate(0, 4096, 65535); 
    end; 
    Destructor TMallocComponentObject.Destroy; 
    // 
    // Назначение. Разрушить кучу, если она была создана. 
    // 
    begin 
    if FHeapHandle > 0 then 
    HeapDestroy(FHeapHandle) ; 
    Inherited Destroy; 
    end; 
    //=============================================^=================^^=== 
    // Методы интерфейса lUnknown класса TMallocComponentObject 
    / / ____________=:===__=—— ———————————_______________________________________ 
    function TMallocComponentObject.Querylnterface(const IID: TGUID; 
    var Obj): Integer; stdcall; 
    //-..-———————-—_——————————————————————————————^—^—__________———————__.-_.-——— 
    // Назначение. Определить, поддерживает ли этот интерфейсный 
    // объект запрошенный клиентом интерфейс. 
    // Если поддерживает, вернуть ссылку на запрошенный интерфейсный объект. 
    // 
    begin 
    // Параметры "out" всегда инициализируются значением Nil. 
    Pointer (oBJ") := Nil; 
    Result := E_NOINTERFACE; // По умолчанию 
    // интерфейс не поддерживается. 
    // Поддерживаются интерфейсы lUnknown и IClassFactory. 
    if IsEqualCLSID(iid, IID_IUnknown) or 
    IsEqualCLSIDfiid, IID_IMalloc) then 
    begin 
    // Запрашиваемые интерфейсы действительно 
    // поддерживаются, следовательно, увеличиваем 
    // значение FRefCount и возвращаем ссылку на себя. 
    TMallocComponentObject(obj) := Self; 
    TMallocComponentObject(obj).AddRef; 
    ' Result := S_OK; 
    end; 
    end; 
    function TMallocComponentObject.AddRef: Longint; 
    // 
    // Назначение. Увеличить на 1 значение счетчика ссылок 
    // и вернуть новое значение. Не забудьте о значении глобального 
    // счетчика объектов. 
    // 
    begin 
    Inc(FRefCount) ; 
    Inc(Global_Object_Count) ; 
    Result := FRefCount; 
    end; 
    function TMallocComponentObject.Release: Longint; 
    // 
    // Назначение. Уменьшить на 1 значение счетчика ссылок 
    // и вернуть новое значение. Если значение счетчика ссылок равно 


    Глава 19. Работа с интерфейсами СОМ                                 445 


    // 0, значит, клиент не использует составной объект и его можно 
    // уничтожить. Кроме того, уменьшите на 1 значение глобального 
    // счетчика объектов. 
    //________——————————————_————————————————————_—_——— 
    begin 
    Dec(FRefCount) ; 
    Dec (Global_Object_Count); 
    Result := FRefCount; 
    // Проверьте, нужен ли еще объект. 
    // Если нет, его следует разрушить. 
    if FRefCount = 0 then Destroy; 
    end; 
    // 
    // Методы интерфейса IMalloc класса TMallocComponentObject. 
    function TMallocComponentObject.Alloc(cb: Longint): Pointer; 
    // 
    // Назначение. Выделяет блок памяти. 
    // 
    begin 
    Result := HeapAlloc(FHeapHandle, HEAP_ZERO_MEMORY, cb) ; 
    end; 
    function TMallocComponentObject.Realloc(pv: Pointer; cb: Longint): Pointer; 
    // 
    // Назначение. Изменяет размер выделенного блока памяти. 
    // 
    begin 
    Result := HeapReAlloc(FHeapHandle, HEAP_ZERO_MEMORY, pv, cb) ; 
    end; 
    procedure TMallocComponentObject.Free(pv: Pointer); 
    // 
    // Назначение. Освобождает выделенный блок памяти. 
    // 
    begin 
    HeapFree(FHeapHandle, 0, pv) ; 
    end; 
    function TMallocComponentObject.GetSize(pv: Pointer): Longint; 
    // 
    // Назначение. Возвращает размер (в байтах) блока памяти, 
    // выделенного с помощью метода Alloc или Realloc. 
    // 
    begin 
    Result := HeapSize(FHeapHandle, 0, pv); 
    end; 
    function TMallocComponentObject.DidAlloc(pv: Pointer): Integer; 
    // 
    // Назначение. Перечисляет блоки памяти,.выделенные в куче этого объекта. 
    // 
    var 
    phe: TProcessHeapEntry; 
    begin 
    Result := -1; // -1 - не поддерживается. 
    // Неудача, если передан указатель Nil. 
    if pv s= Nil then Exit; 
    д. 
    // Запрос выполнить нельзя, так как Windows 95 
    // не поддерживает функцию HeapWalk. 


    446                                           Часть V. Работа с OLE 


    if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then Exit; 
    Result := 0; // 0 - неудачное завершение. 
    ZeroMemory(@phe, sizeof(TProcessHeapEntry)) ; 
    // Установить переменную Result равной 1 в случае удачного // завершения. 
    while HeapWalk(FHeapHandle, phe) do 
    if phe.lpData = pv then 
    Result := 1; 
    end; 
    procedure TMallocComponentObject.HeapMinimize; 
    // 
    // Назначение. Минимизирует размер кучи насколько это возможно, 
    // освобождая неиспользуемые блоки для операционной системы, 
    // объединяя соседние свободные блоки и фиксируя свободные 
    // страницы памяти. 
    // 
    begin 
    HeapCompact(FHeapHandle, 0) 
    end; 
    /initialization 
    Global_Object_Count := 0;  ) 
    .end. 
    

    Регистрация составного объекта 

    Полностью функциональный сервер СОМ должен иметь две специальные функции 
(DllRegisterServer и DllUnregisterServer), которые экспортируются модулями DLL 
или ЕХЕ. Эти функции обычно вызываются программами установки сервера, такими 
как InstallShield Express, поставляемая вместе с Delphi 3. Разработчики часто 
пользуются утилитой REGSVR32 . ЕХЕ, которая входит в Windows NT версий 3.51 и 
4. Но эта утилита не входит в Windows 95! Непонятно, по каким причинам 
компания Microsoft не включила эту утилиту в Windows 95. Названные выше 
функции будут использованы в примере расширения оболочки Windows, приведенном 
ниже в этой главе. 

    Г Совет 1 
    Для просмотра системного реестра нужно запустить программу REGEDIT.EXE в 
Windows 95 или Windows NT 4.0 и программу REGEDT32 . ЕХЕ — в Windows NT 3.51. 

    LJ 
    Для упрощения примера будем использовать REG-файл Windows. Листинг 19.2 
содержится в файле MSERVER1. REG. Ниже показана иерархия ключей, которая будет 
создана в реестре после обработки REG-файла. 

    HKEY_CLASSES_ROOT 
    CLSID 
    {OAA17140-310-11DO-A45E-444553540000} = "Using Delphi 3 IMalloc Example" 
    InProcServeer32 = <Каталог DLL>\MServerl.dll 

    Для успешной регистрации составной объект должен иметь уникальный 
идентификатор класса, который внесен в реестр в ключ HKEY_CLASSES_ROOT\CLSID. 
Кроме того, в качестве вложенного ключа для строки идентификатора класса 
должен быть создан ключ InProcServer32, содержащий строку, которая указывает 
на содержащий составной объект файл динамической библиотеки или приложения. 
Для обеспечения доступа клиентских приложений к серверу IMalloc описанные 
ключи должны присутствовать в реестре Windows. Приложения клиента и сервера 
могут не присутствовать на компьютере в момент регистрации сервера в системном 
реестре. Для регистрации достаточно дважды щелкнуть на пиктограмме REG-файла в 
окне Windows Explorer или в окне File Manager, в зависимости от используемой 
операционной систе'йы; " 

    ^Ilk    Файл MSERVER1. REG можно найти на дополнительно распространяемой дискете. 


    Глава 19. Работа с интерфейсами СОМ                                447 


    Листинг 19.2. \UDELPHl3\CHPl9\MSERVERl\MSERVERl. REG. Содержимое 
REG-файла, который используется для регистрации составного объекта IMAIIOC в 
сервере MServeri. dll 

    REGEDIT4 '" 
    [HKEY_CLASSES_ROOT\CLSID\{OAA17140-310E-11DO-A45E-444553540000)] 
    @="Using Delphi 3 IMalloc Example" 
    [HKEY_CLASSES_ROOT\CLSID\{OAA17140-310E-llDO-A45E-444553540000}\InProcServer32] 
    @="C:\\UDelphi3\\Chapl9\\MServerl\\MServerl.dll" 
    
    К этом времени составной объект определен и соответствующие записи внесены 
в реестр для обеспечения Windows данными, необходимыми для поиска сервера СОМ. 
Но перед компиляцией проекта необходимо проработать еще два вопроса. 
Во-первых, нужно определить методы взаимодействия системы Windows с сервером 
СОМ на основе динамической библиотеки. Во-вторых, предположив, что связь между 
сервером СОМ и Windows установлена, следует поразмыслить над тем, как создать 
первую копию составного объекта. 

    Взаимодействие Windows с сервером СОМ 

    Система Windows взаимодействует с сервером СОМ через две дополнительные 
функции, которые должны экспортироваться всеми серверами на основе СОМ. Первая 
функция называется DllCanUnloadNow. Она вызывается системой Windows, когда 
система пытается выгрузить сервер СОМ из памяти или когда выполняется функция 
CoFreeUnusedLibraries. Реализация 4>ункции DllCanUnloadNow, показанная ниже, 
заимствована из листинга 19.3, приведенного в этом разделе. 

    function DllCanUnloadNow: HResult; stdcall;                                
    begin                                                                      
    if Global_Object_Count > 0 then                                            
    Result := S_FALSE                                                          
    else                                                                       
    Result := S_OK;                                                            
    end; 

    В результате вызова этой функции сервер СОМ возвращает значение S_OK типа 
HRESULT, если больше не существует активных объектов, и значение S_FALSE — в 
противном случае. В этом и состоит основное назначение переменной Global 
Object Count. Для подсчета общего количества выполняющихся объектов значение 
этой переменной увеличивается и уменьшается при вызове методов AddRef и 
Release соответственно. 
    Второй (и более важной) функцией сервера СОМ является функция 
DllGetClassObject, которая первой вызывается после загрузки сервера в память. 
В листинге 19.3 показан проект MServeri, который содержит функцию 
DllGetClassObject. Этой функции Windows передает идентификатор класса (CLS1D), 
который запросил клиент. Таким образом, сервер может определить, какой 
составной объект нужно создавать. В нашем случае существует только один 
составной объект, поэтому для проверки корректности идентификатора класса, 
который передан нашему серверу, достаточно простого выражения if. 

    if not IsEqualCLSID(CLSID, Class_MallocComponentObject) then 
    begin 
    Result := CLASS_E_CLASSNOTAVAILABLE; 
    Exp
    end; 

    Если передан некорректный идентификатор класса, то возвращается код ошибки 
OLE, который означает, что сервер не поддерживает класса с указанным 
идентификатором. Может возникнуть вопрос, зачем выполнять проверку 
идентификатора класса, если в реестре Windows существуют корректные записи, 
которые указывают на наш сервер? Неужели при вызове нашего сервера неизвестно, 
что именно этот сервер должен быть загружен? Проблема в том, что некоторые 
ключи реестра могут по ошибке ссылаться на созданный нами сервер, ожидая, что 
будет создан совершенно другой составной объект. В этом случае будет создан не 
тот объект, который требуется клиенту. Проверка идентификатора класса 
считается хорошим стилем программирования. 
    После того как сервер определил, что переданное значение CLSID является 
корректным, клиенту нужно вернуть ссылку на специальный интерфейс 
IClassFactory. Этот интерфейс используется исключительно Windows или 
клиентским приложением для производства других интерфейсов, поддерживаемых 
составным объектом. Интерфейс IClassFactory поддерживают все серверы СОМ. В 
листинге 19.4 показан код реализации интерфейса IClassFactory, который при 
желании можно пропустить. Остановимся на последнем интересном факте, на полный 
разбор которого я потра

    448                                           Часть V. Работа с OLE 

    тил несколько месяцев. Просматривая код, используемый для возврата ссылки 
на интерфейс IClassFactory, вы заметите, что, хотя был создан объект класса 
TClassFactory и можно было бы без затруднений передать ссылку на него 
клиентскому приложению, было решено вызвать метод Querylnterface этого 
объекта, запросив интерфейс, идентификатор которого система Windows передала 
нам. Этот метод просто вернет значение Self. 

    with TClassFactory.Create do 
    try 
    AddRef; 
    Result := Querylnterface(IID, InterfaceObject); 
    finally 
    Release; 
    end; 

    Поскольку ссылка на интерфейс была получена с помощью метода 
Querylnterface, ее можно трактовать как интерфейс lUnknown. Таким образом, мы 
создали объект TClassFactory и трактуем его как интерфейсный объект IUnknown 
довольно долго, чтобы определить с помощью метода Querylnterface, поддерживает 
ли объект запрашиваемый клиентом интерфейс. Этот прием станет более понятным 
после описания составных объектов, поддерживающих несколько интерфейсов. В 
заключительной части листинга 19.3 экспортируются две функции, DllCanUnloadNow 
и DllGetClassObject, которые рассматривались выше. 
    Код, показанный в листинге 19.3, находится в файле MSERVER1. DPR на 
дополнительно распространяемой дискете. 

    1 Листинг 19.3. \UDELPHI3\CHP19\MSERVER1\MSERVER1. DPR. Файл проекта 
составного объекта ZMalloc 

    library MServerI; 
    uses 
    Windows, 
    01e2, 
    CIsFactI in 'CIsFactI.pas', 
    Malloci in 'Malloci.pas'; 
    function DllGetClassObject(const CLSID: TGUID; const IID: TIID; 
    var InterfaceObject): HResult; stdcall; 
    begin 
    Pointer(InterfaceObject) := Nil; 
    if not IsEqualCLSID(CLSID, Class_MallocComponentObject) then 
    begin 
    Result := CLASS_E_CLASSNOTAVAILABLE; 
    Exit; 
    end; 
    try 
    with TClassFactory.Create do 
    try 
    AddRef; 
    Result := Querylnterface(IID, InterfaceObject); 
    finally 
    Release; 
    end; 
    except 
    Result := E_OUTOFMEMORY 
    end; 
    end; 
    function DLLCanUnloadNow: HResult stdcall; 
    begin 
    if Global_Object_Count > 0 then 
    Result := S_FALSE 


    Глава 19. Работа с интерфейсами СОМ                                449 


    else 
    Result := S_OK; 
    end;                                                                       
    exports.,..    -    ,.., 
    DllGetClassObject, . 
    DllCanUnloadNow; 
    begin end. 


    ICIassFactory - генератор составных объектов 

    Прежде чем приступить к созданию клиентского приложения для тестирования 
сервера СОМ, нужно ознакомиться с последним файлом исходного кода, который 
представлен в'листинге 19.4. Объект ТС lass Factory используется сервером для 
создания составного объекта с помощью метода Createlnstance. После того как из 
функции DUGetClassObject система Windows получит интерфейс ICIassFactory, 
будет вызван метод Createlnstance интерфейса ICIassFactory. Данный метод, 
наконец, передает клиенту ссылку на запрашиваемый интерфейс, который создается 
методом Createlnstance, если этот интерфейс поддерживает составной объект. 
    Файл CLSFACT1. РАЗ, показанный в листинге 19.4, находится на 
дополнительно распространяемой дискете 

    Листинг 19.4. \UDELPHI3\CHP19\MSERVER1\CLSFACT1. РАЗ. Исходный код 
реализации интерфейса ICIass

    Factory, используемого Windows для создания других интерфейсов 
    unit CIsFacti; ' 
    interface 
    uses 
    Windows, SysUtils, 01e2; 
    type 
    TClassFactory = class (ICIassFactory) 
    private 
    FRefCount: Longint; // Инициализируется значением О; 
    public 
    // Методы интерфейса lUnknown 
    // (ICIassFactory наследует от lUnknown). 
    function Querylnterface(const iid: TIID; var obj): HResult; override; 
    function AddRef: Longint; overrider
    function Release: Longint; override; 
    // Методы интерфейса ICIassFactory. 
    function Createlnstance(unkOuter: lUnknown; const iid: TIID; 
    var obj): HResult; overrider
    function LockServer(fLock: BOOL): HResult; overrider
    end; 
    implementation 
    uses Malloci, dialogs; 
    // Методы интерфейса IMalloc класса TClassFactory. 
    function TClassFactory.Querylnterface(const IID: TGUID; 
    var Obj): Integer; 
    // 


    450                                           Часть V. Работа с OLE 


    // Назначение. Определить, поддерживает ли этот интерфейсный 
    // объект запрошенный клиентом интерфейс. 
    // Если поддерживает, вернуть ссылку на запрошенный интерфейсный объект. 
    // 
    begin 
    // Параметры "out" всегда инициализируются значением Nil. 
    Pointer(obj) := Nil; 
    Result := E_NOINTERFACE; //По умолчанию 
    // интерфейс не поддерживается. 
    // Поддерживаются интерфейсы lUnknown и IClassFactory. 
    if IsEqualCLSID(iid, IID_IUnknown) or 
    IsEqualCLSID(iid, IID_IClassFactory) then 
    begin 
    lUnknown(obj) := Self; 
    lUnknown(obj).AddRef; 
    Result := S_OK; 
    end; 
    end; 
    function TClassFactory.AddRef: Longint; 
    // 
    // Назначение. Увеличить на 1 значение счетчика ссылок 
    // и вернуть новое значение. Не забудьте о значении глобального 
    // счетчика объектов. 
    // 
    begin 
    Inc (FRef Count) ; 
    Inc(Global_Object_Count) ; 
    Result := FRefCount; 
    end; 
    function TClassFactory.Release: Longint; 
    // 
    // Назначение. Уменьшить на 1 значение счетчика ссылок 
    // и вернуть новое значение. Если значение равно 0, значит, 
    // клиент больше не использует составной объект и его можно 
    // уничтожить. Кроме того, уменьшите на 1 значение глобального 
    // счетчика объектов. 
    // 
    begin 
    Dec(FRefCount) ; 
    Dec(Global__Object_Count) ; 
    Result := FRefCount; 
    // Проверьте, нужен ли еще объект. 
    // Если нет, его следует разрушить. 
    if FRefCount = 0 then Destroy; 
    end; 
    // Методы интерфейса IClassFactory класса TClassFactory 
    // 
    function TClassFactory.Createlnstance(unkOuter: lUnknown; 
    const iid: TIID; var obj): HResult; 
    // 
    // Назначение. Если запрошенный клиентом интерфейс поддерживается, 
    // то создается интерфейсный объект, добавляется единица к его 
    // значению счетчика ссылок и клиенту возвращается указатель на 
    // интерфейс. 
    // 
    var 
    MallocComponentObject: TMallocComponentObject; 
    begin 


    Глава 19. Работа с интерфейсами СОМ                                 451 


    // Параметры "out" всегда инициализируются значением Nil. 
    Pointer(Obj):= Nil; 
    // Объединение интерфейсов не поддерживается. 
    if (UnkOuter <> Nil) then 
    begin 
    Result := CLASS_E_NOAGGREGATION; 
    Exit; 
    end; 
    // Создание объекта управления памятью. 
    try 
    MallocComponentObject := TMallocComponentObject.Create; 
    try 
    AddRef; 
    // Вернуть требуемый интерфейс, если такой поддерживается. 
    Result := MallocComponentObject.Querylnterface(IID, Obj); 
    finally 
    Release; 
    end; 
    except 
    // Создание составного объекта завершилось неудачей. 
    Result := E_OUTOFMEMORY; 
    end; 
    end; 
    function TClassFactory.LockServer(fLock: Bool): HResult; 
    // 
    // Назначение. Если клиент хочет держать сервер загруженным в 
    // память, нужно воспользоваться этим методом. 
    // Мы увеличиваем и уменьшаем значение глобального счетчика ссылок, 
    // чтобы заблокировать и разблокировать сервер. 
    // 
    begin 
    if fLock then 
    Inc(Global_Object_Count) 
    else 
    Dec(Global_Object_Count) ; 
    Result := NOERROR; 
    end; 
    end. 

    Здесь были описаны все основные этапы создания сервера СОМ. В следующем 
разделе вы узнаете, сколько усилий нужно затратить на создание клиентского 
приложения, которое будет использовать наш сервер СОМ. Но сначала 
удостоверьтесь, что файл MServerl.dpr был скомпилирован в динамическую 
библиотеку, а файл MServerl.reg был выполнен на вашем компьютере. Если 
исходный код примеров книги расположен в отличном от d: \UDELPHI3 . . . 
каталоге, то следует воспользоваться редактором текстов для изменения пути к 
серверу в файле MServerI. reg. Теперь созданный нами сервер может 
использоваться клиентскими приложениями. 

    Создание клиента для интерфейса IMalloc 

    В листинге 19.5 показан проект создания клиентского приложения, которое 
получает интерфейс IMalloc у сервера СОМ Malloci, созданного нами в предыдущем 
разделе. Клиентское приложение прежде всего вызывает функцию Colnitialize, 
чтобы загрузить библиотеку СОМ. Перед вызовом любой функции из библиотеки 
необходимо загрузить эту библиотеку так же, как после окончания работы с 
библиотекой СОМ, выгрузить ее из памяти с помощью функции CoUninitialize. 
    Для загрузки в память всей библиотеки вместо 4)ункции Colnitialize нужно 
вызвать функцию Olelnitialize. Для выгрузки библиотеки OLE из памяти 
воспользуйтесь функцией OleUninitialize. ззмвтку 

    452                                           Часть V. Работа с OLE 

    После загрузки в память библиотеки СОМ клиентское приложение вызывает 
функцию СОМ CoCreateInstance. Эта функция получает в качестве параметра 
идентификатор класса составного объекта — тип сервера, который нужно найти, 
идентификатор стартового интерфейса (I1D) и переменную со стороны клиента, в 
которой будет передана ссылка на интерфейсный объект IMalloc, созданный 
сервером СОМ. 

    OleCheck(CoCreateInstance(Class Malloc ComponentObject, 
    Nil, CLSCTX^NPROC^SERVER^IDD^Malloc, Malloc)); 

    Единственный вызов функции CoCreateInstance заставляет Windows выполнить 
все этапы создания сервера СОМ, описанные выше. Этот вызов заключен в функцию 
oieCheck, обрабатывающую любые ошибки OLE/COM, которые могут возникнуть. В 
случае возникновения ошибки функция OleCheck генерирует исключительную ситуацию. 
    Для создания составного объекта можно также использовать функцию 
CoGetClassObject. Обычно она используется для создания нескольких интерфейсных 
объектов для составного объекта, идентификатор клас" са которого записан в 
реестре Windows. После вызова этой функции для создания неинициализированных 
объектов будет вызван метод IClassFactory. Createlnstance. He всегда нужно 
идти таким сложным путем. Для создания одного объекта можно использовать 
функцию CoCreateInstance. 
    После получения клиентом ссылки на интерфейсный объект IMalloc этот объект 
можно использовать как любой другой экземпляр класса Delphi, как будет 
показано в примере клиентского приложения. Единственное различие между 
объектами СОМ и Delphi состоит в том, что объекты СОМ создаются внутри сервера 
СОМ, а не внутри клиентского приложения. 
    После запуска клиентского приложения на экране появится несколько 
сообщений об успешном использовании интерфейса IMalloc клиентским приложением. 
Одно из сообщений должно указывать, что в Windows 95 метод IMalloc . DidAlloc 
не сработал, так как функция HeapWalk, которую использует сервер СОМ, не 
поддерживается системой Windows 95. 
    Файл MCLIENT. DPR, содержимое которого приведено в листинге 19.5, 
находится на дополнительно распространяемой дискете. 

    Листинг 19.5. \UDELPHi\CHPl9\MCLiENT\MCLiENT. DPR. Файл проекта, 
используемый для тестирования сервера 

    IMalloc 
    program MClient; 
    uses Windows, OLE2, Dialogs, ComObj; 
    const 
    // (OAA17140-310E-11DO-A45E-444553540000) 
    Class_MallocComponentObject: TCLSID = ( 
    D1:$OAA17140; D2:$310E; D3:$11DO; D4 : ($A4, $5E, $44 , $4-5, $53, $54 , 
$00, $00) ) ; 
    // 
    // Назначение. Тестирование сервера СОМ Imalloc. // 
    var 
    Malloc: IMalloc; 
    Str: PChar; 
    begin 
    // Прежде всего, убедитесь, что динамическая библиотека служб 
    // СОМ компании Microsoft загружена. 
    if Succeeded(Colnitialize(Nil)) then 
    try 
    OleCheck( CoCreateInstance( 
    Class MallocComponentObject, Nil, 
    CLSCTX_INPROC_SERVER, 
    IID_IMalloc, 
    Malloc) ) ; 
    try 
    Str := Malloc.Alloc(4096); 
    if Assigned(Str) then 
    try 
    if Malloc.DidAlloc(Str) = 1 then // He поддерживается 
    // в Windows 95. 


    Глава 19. Работа с интерфейсами СОМ                                453 


    ShowMessage('Memory was definately allocated'); 
    ZeroMemoryfStr,4096) ; 
    ShowMessage('4096 bytes allocated and zeroed out.'); 
    Malloc.ReAlloc(Str, 8192); 
    if Assigned(Str) then 
    begin 
    ZeroMemoryfStr, 8192); 
    ShowMessage('8192 bytes reallocated and zeroed out.'); 
    end; 
    finally 
    Malloc.Free(Str) ; 
    end; 
    finally 
    Malloc.Release; // С интерфейсным объектом IMalloc 
    // работа закончена. 
    end; 
    finally 
    CoUnInitialize; // Выгрузить из памяти библиотеку 
    // служб СОМ компании Microsoft. 
    end; 
    end. 


    Использование нового языкового расширения Delphi 

    Как вы могли заметить, создание простого сервера СОМ требует кода довольно 
большого объема. Изначальной целью включения всего показанного кода в главу 
было стремление позволить читателю почувствовать благодарность к разработчикам 
Delphi 3 за внесенные в язык расширения, которые значительно упрощают создание 
серверов СОМ. В Delphi 3 появились два изменения, которые касаются объектов 
СОМ. Во-первых, в язык Delphi были внесены новые семантические конструкции, 
поддерживающие создание интерфейсов и призванные сделать этот процесс таким же 
простым, как создание классов. Во-вторых, в Delphi 3 реализована полная 
архитектура ActiveX (Delphi ActiveX, DAX), которая выполняет большую часть 
рутинных задач, таких как подсчет ссылок, регистрация, создание составных 
объектов и т.п. Чтобы "продемонстрировать простоту создания объектов СОМ с 
помощью Delphi 3, в этом разделе показан способ создания того же сервера 
IMalloc с помощью новой инструкции Interface языка Delphi и архитектуры DAX. 
Для начала рассмотрим определение интерфейсов. 

    Ключевое слово Interface 

    Определение интерфейса IMalloc, выполненное с помощью нового ключевого 
слова interface, выглядит следующим образом. 

    IMalloc = interface(IDnknown) 
    ['{0000002-0000-0000-COOO-000000000046}'] 
    function Alloc(cb: Longint): Pointer; stdcall; 
    function Realloc(pv: Pointer; cb: Longint): Pointer; stdcall; 
    procedure Freefpv: Pointer); stdcall; 
    function GetSizetpv: Pointer): Longint; stdcall; 
    function DidAllocfpv: Pointer): Integer; stdcall; 
    procedure HeapMinimize; stdcall; 
    end; 

    Прежде всего, заметьте, что в новом определении интерфейса отсутствует 
конструкция abstract; virtual;. Это стало возможным благодаря тому, что все 
методы интерфейсного объекта должны быть чисто виртуальными по умолчанию. 
Нужно обратить внимание на еще одну особенность — идентификатор класса встроен 
в 'определение интерфё^саГ что улучшает читабельность кода, но еще лучше то, 
что имя интерфейса может использоваться в качестве константы идентификатора 
класса (CLSID). Для выполнения сравнений идентификаторов CLSID можно 
воспользоваться функцией IsEqualCLSID, как показано ниже. 

    if IsEqualCLSID(iid, IMalloc) then ... 


    454                                           Часть V. Работа с OLE 


    Теперь рассмотрим интерфейс lUnknown, от которого наследован интерфейс IMalloc. 
    lUnknown = interface 
    ['{ОООООООО-ОООО-ОООО-СООО-000000000046)'] 
    function Querylnterface(const IID: TGUID; out Obj): Integer; stdcall; 
    function _AddRef: Integer; stdcall; 
    function _Release: Integer; stdcall; 
    end; 

    Определение интерфейса lUnknown (абстрактный класс), используемое нами в 
сервере СОМ Malloci, помещено в модуль OLE2. Этот модуль включен в Delphi Здпя 
обеспечения обратной совместимости. Описываемое здесь новое определение 
HHTep$e"RcaTUnknown помещено в модуль System. И хотя новая реализация 
интерфейса lUnknown очень похожа на реализацию этого интерфейса, помещенную в 
модуль OLE2, между этими реализациями существует незначительное различие. 
Названия методов AddRef и Release теперь предварены символом подчеркивания 
(_AddRef и _Release). Такой прием применен, чтобы избежать использования этих 
методов,~так"как 15е1рг>Гавтоматически вызывает методы AddRef и Release, когда 
интерфейсные переменные соответственно входят в область определения и выходят 
из нее. Более детально это описано в руководстве по языку Object Pascal. 
    Delphi 3 определяет интерфейсы OLE с помощью инструкции interface в модуле 
ActiveX. Интерфейсы lUnknown и IDispatch определены в модуле System. 

    TComObject - базовый класс архитектуры DAX 

    Большой проблемой при разработке составных объектов является код подсчета 
ссылок, который должен быть связан с каждым интерфейсным объектом СОМ. Вы уже 
заметили, что даже объект IClassFactory в сервере СОМ MServerI должен 
реализовать методы AddRef и Release интерфейса lUnknown. Кроме того, для 
серверов, которые будут предоставлять клиентам интерфейсы, нужно реализовать 
метод Querylnterface интерфейса lUnknown. Введение класса TComObject, который 
является базовым классом архитектуры DAX, позволит разработчикам-забыть,_о.б. 
интерфейсе lUnknown. Класс TComObject реализует интерфейс lUnknown, и 
разработчик может сосредоточиться на создании новых интёрфейс"ных объектов с 
помощью Delphi 3. Для реализации интерфейса IMalloc нужно создать класс, 
показанный ниже. 

    type 
    TMallocComponentObject = class(TComObject, IMalloc) private 
    FHeapHandle: THandle; 
    public 
    // Метод TComObject, используемый вместо конструктора Create. 
    procedure Initialize; override; 
    Destructor Destroy; override; 
    // Методы интерфейса Imalloc. 
    function Alloc(cb: Longint): Pointer; stdcall; 
    function Realloc(pv: Pointer; cb: Longint): Pointer; stdcall; 
    procedure Freetpv: Pointer); stdcall; 
    function GetSize(pv: Pointer): Longint; stdcall; 
    function DidAlloc(pv: Pointer): Integer; stdcall; 
    procedure HeapMinimize; stdcall; 
    end; 

    В приведенном фрагменте кода присутствует несколько интересных моментов. 
Во-первых, список предкрд содержит_цва..эдемента. Delphi 3 требует, чтобы 
первым элементом списка был класс, наследованный от KnaccsTTbbject, но в 
списке можно указывать любое количество интерфейсов. Это позволяет 
поддерживать столько интерфейсов, сколько нужно. Как будет показано в 
посвященной технологии ActiveX главе, именно в этом нуждается большинство 
клиентов. Поскольку создаваемый класс происходит от класса TComObject, подсчет 
ссылок уже реализован и переопределять метод Querylnterface не нужно. 
Следовательно, можно сосредоточиться только на реализации методов интерфейса 
IMalloc, которые ничем не отличаются от их аналогов, описанных раньше. 
Обратите внимание на еще одну, менее важную, деталь — вместо создающего объект 
конструктора для инициализации используется переопределенный метод Initialize 
класса TComObject. Такой прием применен потому, что конструкторы создания 
объектов сделаны статическими, так как используются только~кл5ссом 
TComObjectFactory. В листинге 19.6 приведен полный исходный код реализации 
объекта TMallocComponentObject. Этот код находится в файле MALLOC2. РАЗ на 
дополнительно распространяемой дискете. 

    Глава 19. Работа с интерфейсами СОМ                                 455 


    ,: Листинг 19.6. \UDELPHl3\CHP19\MSERVER2\MALLOC2. PAS. Реализация 
интерфейса iMalloc с помощью архитектуры DAX 

    unit Malloc2; 
    interface uses Windows, SysUtils, Classes, ActiveX, ComObj, ComServ; 
    const 
    Class MallocComponentObject: 
    TCLSID = 40AA17140-310E-11DO-A45E-444553540000)•; 
    type 
    TMallocComponentObject = class(TComObject, IMalloc) private 
    FHeapHandle: THandle; 
    public 
    // Метод TComObject, используемый вместо 
    // конструктора Create. 
    procedure Initialize; override; 
    Destructor Destroy; override; 
    // Методы интерфейса Imalloc. 
    function Allocfcb: Longint): Pointer; stdcall; 
    function Realloc(pv: Pointer; cb: Longint): Pointer; stdcall; 
    procedure Free(pv: Pointer); stdcall; 
    function GetSizefpv: Pointer): Longint; stdcall; 
    function DidAlloc(pv: Pointer): Integer; stdcall; 
    procedure HeapMinimize; stdcall; 
    end; 
    implementation 
    const 
    // Эта константа не определена в Delphi 3.0; 
    // используется в HeapCreate и т.д. 
    HEAP_ZERO_MEMORY = $00000008; 
    procedure TMallocComponentObject.Initialize; 
    //-————_——_——_—_-_-__-_-_—_-_-_____-_-______-_____________________ 
    // Назначение. Запрашивает блок виртуальных адресов 
    // размером 64 Кбайт 
    //и фиксирует 4 Кбайт виртуальной памяти. Сохраняет дескриптор 
    // кучи (heap) в переменной HeapHandle. 
    // Эта переменная будет использоваться функциями работы с кучей 
    // в других методах. Если HeapHandle = 0, то функции работы с кучей 
    // завершатся неудачно. 
    // 
    begin 
    FHeapHandle := HeapCreate (0, 4096, 65535); 
    end; 
    Destructor TMallocComponentObject.Destroy; 
    // 
    // Назначение. Разрушить кучу, если она была создана. 
    // 
    begin 
    if FHeapHandle > 0 then HeapDestroy(FHeapHandle) ; 
    Inherited Destroy; 
    end; 


    456                                           Часть V. Работа с OLE 


    // Методы интерфейса IMalloc класса TMallocComponentObject. 
    function TMallocComponentObject.Alloc(cb: Longint): Pointer; 
    // 
    // Назначение. Выделяет блок памяти. // 
    begin 
    Result := HeapAlloc(FHeapHandle, HEAP_ZERO_MEMORY, cb); 
    end; 
    function TMallocComponentObject.Realloc(pv: Pointer; 
    cb: Longint): Pointer; 
    // 
    // Назначение. Изменяет размер выделенного блока памяти. 
    // 
    begin 
    Result := HeapReAlloc(FHeapHandle, HEAP_ZERO_MEMORY, pv, cb); 
    end; 
    procedure TMallocComponentObject.Free(pv: Pointer); 
    // 
    // Назначение. Освобождает выделенный блок памяти. 
    // 
    begin 
    HeapFree(FHeapHandle, 0, pv); 
    end; 
    function TMallocComponentObject.GetSize(pv: Pointer): Longint; 
    // 
    // Назначение. Возвращает размер (в байтах) блока памяти, 
    // выделенного с помощью методов Alloc или Realloc. 
    // 
    begin 
    Result := HeapSize(FHeapHandle, 0, pv); 
    end; 
    function TMallocComponentObject.DidAlloc(pv: Pointer): Integer; 
    // 
    // Назначение. Перечисляет блоки памяти, выделенные в куче этого объекта. 
    // 
    var 
    phe: TProcessHeapEntry; 
    begin 
    Result := -1; // -1 - не поддерживается. 
    // Неудача, если передан указатель Nil. 
    if pv = Nil then Exit; 
    /'/ Запрос выполнить нельзя, так как Windows 95 
    //не поддерживает функцию HeapWalk. 
    if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then Exit; 
    Result := 0; // 0 - неудачное завершение. 
    ZeroMemory(@phe, sizeof(TProcessHeapEntry)) ; 
    // Установить переменную Result равной 1 в случае удачного 
    // завершения. 
    while HeapWalk(FHeapHandle, phe) do 
    if phe.lpData = pv then 
    Result := 1; 
    end; 
    procedure TMallocComponentObject.HeapMinimize; 
    // 
    Глава 19. Работа с интерфейсами СОМ                                457 

    // Назначение. Минимизирует размер кучи насколько это возможно, 
    // освобождая неиспользуемые блоки для операционной системы, 
    // объединяя соседние свободные блоки и фиксируя свободные 
    // страницы памяти. 
    // 
    begin 
    HeapCompact(FHeapHandle, 0) 
    end; 
    end. 


    TComObjectFactory и сервер СОМ Delphi 

    Наверное, вы заметили, что новые расширения языка Delphi и класс 
TComObject в составе архитектуры DAX незнг чительно уменьшили объем 
создаваемого кода, но существует еще одно усовершенствование. Вспомните первый 
пример в котором для реализации механизма IClassFactory потребовалось создавать 
целый модуль. А использование класс TComObjectFactory позволяет вообще не 
создавать интерфейса IClassFactory. Кроме всего прочего, архитектур, DAX 
сопровождает объект сервера СОМ, поэтому составные объекты поддерживают 
регистрацию самих себя посредст вом экспорта двух функций: DllRegisterServer и 
DllUnregisterServer. Термин регистрация самих себя здео применен не совсем 
корректно, так как он обозначает автоматическую регистрацию, а это не совсем 
так. Рассматриваемые функции должны быть кем-то вызваны, чтобы составные 
объекты зарегистрировались. Регистрация самих себя означает, что, когда 
потребуется, сервер СОМ будет способен внести в реестр необходимые данные. В 
резюме этой главы показано, как создать контекстное меню — расширение оболочки 
Windows, которое позволяет после щелчка правой кнопкой мыши на динамической 
библиотеке регистрировать и удалять ее из реестра. Функция DllRegisterServer 
сервера MServer2 после вызова внесет в реестр данные, показанные ниже. 

    HKEY_CLASSES_ROOT 
    CLSID 
    {OAA1740-310E-11DO-A45E-444553540000} = "Using Delphi 2 IMalloc Example" 
    InProcServer32 = <Путь к D11> 
    ProgID = MSERVER2.IMalloc 
    HKEY_CLASSES_ROOT 
    MSERVER2.IMalloc = "Using Delphi 3 IMalloc Example" 
    CLSID = {OAA1740-310E-11DO-A45E-444553540000} 

    Для того чтобы эти данные были внесены в реестр, необходимо, чтобы 
составной объект был зарегистрирован вместе с сервером, определенным в модуле 
ComServ. Для этого для каждого составного объекта, предоставляемого 
пользователям, нужно создать новую копию объекта TComObjectFactory. В листинге 
19.7 показано, как выполняются перечисленные действия для сервера MServer2. 
Заметьте, что в этом листинге 19.7 все четыре функции СОМ экспортируются (они 
объявлены в модуле ComServ). 
    Идентификатор программы (ProgID), который вносится в реестр, создается на 
основе имени файла динамической библиотеки или приложения и имени класса, 
которое использовалось, когда посредством создания -  объекта 
TComObjectFactory объект TComObject регистрировался вместе с сервером 
COMServer. Следовательно, этот сервер создал идентификатор ProgID, названный 
MSERVER. IMalloc. Идентификатор ProgID представляет собой текстовую ссылку на 
сервер СОМ через идентификатор класса. 
    Файл MSERVER2. DPR, содержимое которого представлено в листинге 19.7, 
находится на дополнительно распространяемой дискете. 

    Листинг 19,7. \UDELPHI3\CHP19\MSERVER2\MSERVER2. DPR. Исходный код модуля, 
регистрирующего составной 

    j объект IMalloc 
    library MServer2; 
    uses 
    ComObj, ComServ, 
    Malloc2 in 'Malloc2.pas'; 


    458                                           Часть V. Работа с OLE 


    exports 
    DllGetClassObject, 
    DllCanUnloadNow, 
    DllRegisterServer, 
    DllUnregisterServer; 
    begin 
    TComObjectFactory.Create( 
    ComServer,                        // Сервер СОМ Delphi 
    //в файле ComServ.pas. 
    TMallocComponentObject,           // Наследник класса TComObject. 
    Class MallocComponentObject,      // Идентификатор класса 
    // составного объекта. 
    'IMalloc',                        // Вторая часть идентификатора 
    // программы ProgID. 
    'Using Delphi 3 IMalloc Example', // Описание составного объекта. 
    cisinglelnstance);                // Каждый раз создается новая копия. 
    end. 


    Резюме 

    В этой главе были рассмотрены способы создания серверов СОМ, 
предназначенных для использования клиентскими приложениями, создаваемыми 
пользователями. Но нередко возникает ситуация, когда клиентом сервера СОМ 
является сама система Windows. Последним примером, который будет рассмотрен в 
этой главе, является пример расширения оболочки Windows. Существует несколько 
типов расширений оболочки Windows, но здесь речь пойдет о создании оболочки — 
контекстного меню. Контекстное меню — это всплывающее меню, которое появляется 
на экране после щелчка правой кнопкой мыши на одном из файлов списка. В этом 
разделе вы узнаете, как создать обработчика контекстного меню, который 
позволяет регистрировать и удалять из реестра информацию о DLL- и ОСХ-серверах 
посредством добавления в контекстное меню нескольких пунктов. Таким образом, 
рассмотрим работу сервера СОМ, обеспечивающего выполнение описанных действий. 

    Создание обработчика контекстного меню AXReg 

    Обработчик контекстного меню требует, чтобы составной объект поддерживал 
два специфических интерфейса: 

    IShellExtInit и IContextMenu. Эти интерфейсы определены в модуле ShIObj. 
Составной объект TContextMenu использует эти интер4)ейсы, как показано ниже. 
    TContextMenu = class(TComObject, IShellExtInit, IContextMenu) 
    // Раздел private пропущен. 
    public 
    // Повторное объявление для реализации методов 
    // интерфейса IContextMenu. 
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, 
    idCmdLast, uFlags: UINT): HReault; StdCall; 
    function InvokeCommand(var Ipici, uType: UINT; pwReserved: PUINT; 
    pszName: LPSTR; cchMax: UINT): HResult; StdCall; 
    // Повторное объявление для реализации метода 
    // интерфейса IShellExtInit. 
    function Initialize(pidFolder: PItemDList; Ipdobj: IDataObject; 
    hKeyProgID: HKEY): HResult; StdCall; 
    end; 

    Полная версия исходного кода приведена в листинге 19.8. Заметьте, что в 
списке предков определяемого класса указано два интерфейса, а это означает, 
что класс будет поддерживать оба интерфейса. Система Windows будет 
использовать интерфейс IShellExtInit для передачи в обработчик контекстного 
меню одного или нескольких файлов, выделенных пользователем. В данном случае 
нужно обрабатывать файлы по отдельности. Когда бы ни был вызван метод 
Initialize интерфейса IShellExtInit, необходимо сохранять имя выбранного 
файла, чтобы оно было доступным при вызове различных методов интерфейса IContextMenu. 
    Список выбранных файлов передается в метод Initialize с помощью 
интерфейсного объекта IDataObject, который создается системой Windows. Имена 
файлов в объекте IDataObject хранятся в виде списка имен, разделенных 

    Глава 19. Работа с интерфейсами СОМ                                459 

    парами нулей. Поскольку интерфейсный объект передан из Windows и обе 
стороны — Windows и сервер СОМ — создают интерфейсные объекты, довольно сложно 
определить, кто является сервером, а кто — клиентом. 
    Интерфейс IContextMenu обладает тремя методами: QueryContextMenu, 
InvokeCommand и GetCommandString. Метод QueryContextMenu вызывается системой 
Windows для получения новых команд, которые нужно добавить в контекстное меню. 
Метод InvokeCommand косвенно вызывается системой Windows, когда пользователь 
выбирает один из пунктов контекстного меню, который относится к нашему 
обработчику меню. Метод GetCormnandString вызывается системой Windows, когда 
нужно показать на экране строку контекстной справки о команде меню, на которой 
пользователь остановил на некоторое время указатель мыши. Таким образом, за 
исключением специальных данных, вносимых в реестр Windows, мы рассмотрели все, 
что нужно для создания обработчика контекстного меню. 
    Файл CONTEXTM. РАЗ, содержимое которого представлено в листинге 19.8, 
находится на дополнительно распространяемой дискете. 

    Листинг 19.8. \UDELPHl3\CHPl9\AXREG\coNTEXTM. PAS. Определение и 
реализация расширения оболочки Windows - обработчика контекстного меню, 
обеспечивающего регистрацию серверов ActiveX 

    unit ContextM; 
    interface 
    uses 
    Windows, SysUtils, ComObj, ComServ, ShIObj, ActiveX, ShellApi; 
    Const 
    Class_ContextMenu: TGUID = '(A0516FEO-2F5D-11DO-A45E-444553540000}'; 
    Class_ContextMenuString = '(A0516FEO-2F5D-11DO-A45E-444553540000)' ; 
    type 
    TContextMenu = class(TComObject, IShellExtInit, IContextMenu) 
    private 
    szFile: array[0..MAX_PATH] of Char; 
    // Статический внутренний метод. 
    function CallActiveXServerProc(ProcName : String): Boolean; 
    public 
    // Повторное объявление для реализации методов 
    // интерфейса IContextMenu. 
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, 
    idCmdLast, uFlags: UINT): HResult; StdCall; 
    function InvokeCommand(var Ipici: TCMInvokeCommandInfo) 
    :HResult; StdCall; 
    function GetCommandString(idCmd, uType: UINT; pwReserved: POINT; 
    pszName: LPSTR; cchMax: UINT): HResult; StdCall; 
    // Повторное объявление для реализации метода 
    // интерфейса IShellExtInit. 
    // Примечание. Этот метол скрывает виртуальный метод Initialize 
    // класса TComObject. 
    function Initialize(pidlFolder: PItemIDList; Ipdobj: IDataObject; 
    hKeyProgID: HKEY): HResult; StdCall; 
    end; 
    implementation 
    const 
    ID_REGISTER = 0; 
    ID_UNREGISTER = 1; 
    function TContextMenu.CallActiveXServerProc(ProcName : String): Boolean; 
    //—————————.—————————————-——-————————————_———_-
    // Назначение. Загрузить выбранный модуль ОСХ/DLL и вызвать 
    // из него функцию DllRegisterServer или 


    460                                           Часть У. Работа с OLE 


    // DllUnregisterServer. Если функцию нельзя найти, значит, 
    // этот модуль не является сервером ActiveX. 
    // 
    type 
    TProcStdCall = procedure; StdCall; 
    var 
    DllHandle : THandle; 
    DllProc   : TProcStdCall; 
    begin 
    Result := False; 
    try 
    DllHandle := LoadLibrary(szFile); 
    if DllHandle <> 0 then 
    try 
    @DllProc := GetProcAddress(DllHandle, PChar(ProcName)) ; 
    if @DllProc <> Nil then 
    begin 
    DllProc; 
    Result := True; 
    end; 
    finally 
    FreeLibrary(DllHandle) ; 
    end; 
    except 
    end; 
    end; 
    function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, 
    idCmdFirst, idCmdLast, uFlags: UINT): HResult; 
    // 
    // Назначение. Вставить пункты контекстного меню и вернуть 
    // число вставленных элементов. 
    // 
    begin 
    // Добавить два элемента в контекстное меню для файлов типа DLL. 
    InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, 
    idCmdFirst + ID_REGISTER, 'Register Active X Server'); 
    InsertMenu (Menu, indexMenu + 1, MFJ3TRING or MF_BYPOSITION, 
    idCmdFirst + ID_UNREGISTER, 'Unrregister Active X Server'); 
    // Вернуть количество добавленных элементов. 
    Result := 2; 
    end; 
    function TContextMenu.InvokeCommand(var Ipici: TCMInvokeCommandInfo) 
    :HResult; 
    // 
    // Назначение. Выполнить операцию, соответствующую 
    // выбранному элементу меню. 
    // 
    const 
    SuccessStringTemplate = 'The Active X server was %s successfully.'; 
    FailStringTemplate = 
    'Attempt to register/unregister the selected OCX/DLL server failed.'; 
    var 
    MessageString : String; 
    begin 
    // Удостоверьтесь, что функция вызвана не приложением. 
    if HiWord(Integer(Ipici.IpVerb)) <> 0 then 
    begin 
    Result := E_FAIL; 
    Exit; 
    end; 


    Глава 19. Работа с интерфейсами СОМ                                 461 


    Result := NOERROR; 
    // Выполните команду, указанную в переменной Ipici.IpVerb. 
    MessageString := FailStringTemplate; // Присваивается повторно 
    // в случае удачного 
    // завершения. 
    case LoWord(Ipici.IpVerb) of 
    ID_REGISTER: 
    if CallActiveXServerProc('DllRegisterServer') then 
    MessageString := Format(SuccessStringTemplate, ['registered']) 
    else 
    Result := E_FAIL; 
    IDJJNREGISTER: 
    if CallActiveXServerProc('DllUnregisterServer') then 
    MessageString := Format(SuccessStringTemplate, ['unregistered']) 
    else 
    Result := E_FAIL; 
    else 
    // Получено неверное число аргументов. 
    Result := E_INVALIDARG; 
    Exit; 
    end; 
    if Result = E_FAIL then MessageString := 'Operation failed'; 
    MessageBox(Ipici.hWnd, PChar(MessageString) , 'Information', 
    MB_ICONINFORMATION or MB_OK) ; 
    end; 
    function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; 
    pszName: LPSTR; cchMax: UINT): HRESULT; 
    // 
    // Назначение. Определить и вернуть строку справки 
    // для выбранного элемента меню. 
    // 
    const 
    HelpStringTemplate = '%s an OCX/DLL Active X server'; 
    var 
    HelpString : String; 
    begin 
    Result := NOERROR; 
    HelpString := ''; 
    // Определить строку справки. 
    case idCmd of 
    ID_REGISTER:   HelpString := Format(HelpStringTemplate, ['Registers']); 
    ID_UNREGISTER: HelpString := Format(HelpStringTemplate, ['Unregisters' ] ) ; 
    else 
    Result := E_INVALIDARG; 
    Exit; 
    end; 
    StrCopyfpszName, PChar(HelpString)) ; 
    end; 
    function TContextMenu.Initialize(pidlFolder: PItemIDList; Ipdobj: IDataObject; 
    hKeyProgID: HKEY): HResult; 
    // 
    // Назначение. Получить имя выбранного пользователем файла 
    // из переданного в функцию объекта IDataObject. 
    // 
    var 
    StgMedium: TStgMedium; 
    FormatEtc: TFormatEtc; 
    begin 
    // Неудачное завершение, если Ipdobj не содержит указателя 


    462                                           Часть V. Работа с OLE 


    // на IDataObject. 
    if Ipdobj = Nil then 
    begin 
    Result := E_FAIL; 
    Exit; 
    end; 
    with FormatEtc do 
    begin 
    cfFormat := CF_HDROP;         // Получить имена файлов, 
    // разделенные двойными нулями. 
    ptd      := Nil;              // Информацию о приемнике 
    // указывать не нужно. 
    dwAspect := DVASPECT_CONTENT; // Получить контекст. 
    lindex   := -1;               // Получить все данные. 
    tymed    := TYMED_HGLOBAL;    // Среда хранения — глобальный 
    // дескриптор памяти. 
    end; 
    // Передать данные из объекта IDataObject в среду хранения 
    // HGLOBAL в формате CF HDROP (список значений, разделенных 
    // двойным нулем). 
    Result := Ipdobj.GetData(FormatEtc, StgMedium); 
    if Succeeded(Result) then 
    try 
    // Если выделен только один файл, считываем имя файла и 
    // сохраняем его в переменной szFile. 
    // В противном случае — аварийно завершаем функцию. 
    if DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, Nil, 0) <> 1 then 
    Result := E_FAIL 
    else 
    begin 
    DragQueryFile(StgMedium.hGlobal, 0, szFile, SizeOf(szFile)); 
    Result := NOERROR; 
    end; 
    finally 
    ReleaseStgMedium(StgMedium) ; 
    end; 
    end; 
    initialization 
    TComObjectFactory.Create( 
    ComServer, 
    TContextMenu, 
    Class_ContextMenu, 
    'Delphi 3.0 ContextMenu Example', ciMultiInstance) ; 
    end. 

    В листинге 19.9 показано, что для создания проекта AXRegl нужно не так уж 
много. Файл AXREG1. DPR находится на дополнительно распространяемой дискете. 

    Листинг 19.9. \UDELPHI\CHP19\AXREG\AXREG1. DPR. Основной исходный файл 
проекта обработчика контекстного меню, регистрирующего серверы ActiveX 

    library AXRegl; 
    uses 
    ComServ, ContextM in 'ContextM.pas' ; 
    exports 
    DllGetClassObject,    // Реализована в модуле ComServ. 


    Глава 19. Работа с интерфейсами СОМ                                463 


    DllCanUnloadNow,      // Реализована в модуле ComServ. 
    DllRegisterServer,    // Реализована в модуле ComServ. 
    DllUnregisterServer; // Реализована в модуле ComServ. 
    begin 
    TComObjectFactory.Create( 
    ComServer,          // Сервер СОМ Delphi в файле ComServ.pas. 
    TContextMenu,       // Порожденный от TComObject класс. 
    Class_ContextMenu, // Идентификатор класса составного 
    // объекта. 
    // Идентификатора ProgID нет. 
    'Delphi 3.0 ContextMenu Example',    // Описание 
    // составного объекта. 
    ciMultiInstance); // Совместное использование копий. 
    end. 


    Регистрация обработчика контекстного меню AXReg 

    Регистрация обработчика контекстного меню — расширения оболочки Windows — 
несколько отличается от регистрации обычных серверов СОМ. В реестр необходимо 
внести обычные данные, как показано ниже. 

    HKEY_CLASSES_ROOT 
    CLSID 
    {A0516FE1-2F5D-11DO-A45E-444553540000} = "Using Delphi 3 - AXReg 1.0" 
    InProcServer32 = <Path of AXRegl.dll> 
    "ThreadingModel" = "Apartment" 

    Один из ключей должен быть внесен обязательно (это ключ ThreadingModel = 
Apartment, который является вложенным по отношению к ключу InProcServer32). 
Затем в реестр нужно добавить ключи для файлов ОСХ, чтобы запускался ваш 
обработчик контекстного меню. В реестр нужно внести следующие ключи. 

    ...Add context menu support for ОСХ files ----------------------
    HKEY_CLASSES_ROOT 
    .OCX = "OcxFile" 
    OcxFile 
    shellex 
    ContextMenuHandlers 
    {A0516FE1-2F5D-11DO-A45E-444553540000} = "" 

    И наконец, обработчика контекстного меню нужно зарегистрировать и для 
динамических библиотек (DllFile), которые уже зарегистрированы в реестре. 

    ...Add context menu support for DLLs ---------------------------
    HKEY_CLASSES_ROOT 
    DllFile 
    shellex 
    ContextMenuHandlers 
    {A0516FE1-2F5D-11DO-A45E-444553540000} 

    В листинге 19.10 показан REG-файл (AXREG1. REG), который можно выполнить 
для регистрации показанных выше ключей в реестре Windows. В качестве премии я 
создал для вас еще один проект AXReg (AXREG2 . DPR), который можно найти на 
дополнительно распространяемой дискете. В этом проекте реализуются и 
экспортируются функции DllRegisterServer и DllUnregisterServer. Функция 
DllRegisterServer добавляет в реестр все ключи, необходимые для вызова 
созданного нами обработчика сервера расширения оболочки. 

    Листинг 19.10. \UDELPHl3\CHpl9\AXREG\AXREGl.REG. Файл, содержащийключи 
реестра, которыенужновнести в реестр Windows 95 или Windows NT 4 для 
регистрации обработчика контекстного меню 

    REGEDIT4 
    [HKEY_CLASSES_ROOT\DllFile\shellex\ContextMenuHandlers\ 
    (A0516FEO-2F5D-11DO-A45E-444553540000)] ="" 
    [HKEY_CLASSES_ROOT\CLSID\{A0516FEO-2F5D-11DO-A45E-444553540000}] 
    @="D11 Server Register" 
    [HKEY_CLASSES_ROOT\CLSID\{A0516FEO-2F5D-11DO-A45E-444553540000}\InProcServer32] 


    464                                           Часть V. Работа с OLE 


    @="C:\\UDelphi3\\Chapl9\\AXReg\\AXRegl.dll" 
    "ThreadingModel"="Apartment" 
    [HKEY_CLASSES_ROOT\.OCX] 
    @="OcxFile" 
    [HKEY_CLASSES_ROOT\OcxFile\shellex\ContextMenuHandlers\ 
    {A0516FEO-2F5D-11DO-A45E-444553540000}] ="" 

    Для регистрации сервера ActiveX (в данном случае — AXREG1. DLL) дважды 
щелкните на файле AXRegl. reg, который расположен в том же каталоге, что и 
проект AXRegl. Если исходные коды примеров из этой книги находятся в каталоге, 
отличном от каталога \UDELPHI3 . . ., то откройте файл AXRegl. reg в текстовом 
редакторе и укажите корректный путь к файлу AXREG1. DLL. 
    В этой главе рассматривались основные принципы работы архитектуры СОМ и 
связи между составными объектами, интерфейсами и интерфейсными объектами. 
Кроме того, был описан базирующийся на реестре механизм, используемый Windows 
для поиска серверов СОМ. И наконец, читатель получил вводную информацию о 
разработке серверов контекстных меню Windows. На примере разработки такого 
сервера был продемонстрирован способ создания составного объекта, 
поддерживающего несколько интерфейсов. 
    Из следующей главы вы узнаете, насколько легко с помощью Delphi 3 можно 
создавать серверы автоматизации. 

    Глава 19. Работа с интерфейсами СОМ                                 465