1. Задание

В среде Delphi разработать приложение-клиент и приложение-сервер, взаимодействующие по OLE технологии. Сервер должен быть оформлен в виде EXE (сервер out-of-process).
Сервер должен включать два объекта, каждый из которых поддерживает один интерфейс:
• Для вычисления объема, боковой, основания и полной площади поверхности бочки.
• Для вычисления площади и периметра прямоугольного треугольника.
Клиент должен иметь доступ к серверу через диспинтерфейс.

2. Описание геометрических фигур, формулы для расчета заданных параметров

1) Бочка:

Формулы для расчетов:
S (площадь основания) = πR²;
S (площадь боковой поверхности) = 2πRH;
S (площадь полной поверхности) = 2πRH + 2πR²;
V (объём) = πR²H.

2) Треугольник:

Формулы для расчетов:
S (площадь) = 0.5АВ;
Р (периметр) = А+В+(А² +В²)^0.5.

3. Сведения о спроектированных интерфейсах и методах

Для создания внешнего локального сервера OLE в виде отдельного процесса (out-of-process: exe) в Delphi 7 был активирован мастер ActiveX -> Automation Object. Параметры:
• Имя CoClass Name: Geometry;
• Модель создания COM-объектов Multiple Instance, так как согласно ТЗ: сервер должен одновременно обслуживать несколько клиентов;
• Threading Model (Потоковая модель), выбрана Apartment, которая в свою очередь создает STA. Эта модель выбрана с целью защиты данных объекта, т.к. одновременный доступ к одному полю из двух методов невозможен. Вызовы методов объекта COM, живущего в STA, гарантировано будет следовать последовательно один после другого вне зависимости от того, откуда пришел этот поток.

Создана библиотека типов, так как одним из самых универсальных и надёжных способов создания автоматизации маршалинга является способ импортирования библиотеки типов сервера автоматизации, а так же она позволяет провести т.н. “раннее связывание”, т.е. на этапе компиляции клиента связать вызываемые методы с виртуальной таблицей интерфейсов сервера.

Было принято решение использовать два варианта расчёта требуемых параметров бочки и прямоугольного треугольника:
1) через отдельные методы;
2) через один метод(расчет всех параметров в одном методе); что должно обеспечить серверу большую универсальность, а клиенту удобство и выбор.

Было принято решение использовать функции, т.к. существенных отличий между процедурами и функциями нет. Все методы являются функциями с директивой safecall, возвращающими тип HRESULT для передачи информации об ошибках клиенту.

Все методы имеют входные параметры вещественного типа float (в Object Pascal – Single), а выходные – тип float* (указатель на Single). Целочисленные типы данных не используются для обеспечения большой универсальности при задании параметров фигур. Мы выбрали float, поскольку из всех вещественных типов он занимает меньше всего места(4 байта), т.к. в нашем случае нет необходимости в расчетах огромных чисел. Указатели в выходных параметрах ([out] и [out, retval]) используются для передачи данных по адресу, а не по значению; Передачи данных по адресу происходит быстрее, т.к. не происходит копирование и последующее чтение данных из стека.

Для входных данных использован модификатор in вместо const т.к. после выхода из функции не будет производиться проверка на изменение данных, отсюда мы выигрываем в быстродействии.

3.1. Рассмотрим методы интерфейса IBochka:

Код итрефейса IBochka

IBochka = interface(IDispatch)
[‘{29614A10-D147-4F10-B93E-E1E6C8CA57EB}’]
function bochka_ob(R: Single; H: Single; out value: Single): HResult; safecall;
function bochka_area_osn(R: Single; out area: Single): HResult; safecall;
function bochka_area_bok(R: Single; H: Single; out area: Single): HResult; safecall;
function bochka_area_pol(R: Single; H: Single; out area: Single): HResult; safecall;
function Bochka(R: Single; H: Single; out area_osn: Single; out area_bok: Single;
out area_full: Single; out ob: Single): HResult; safecall;
end;

1. Вычисление объема бочки:
function bochka_ob(R, H: Single; out value: Single): HResult; safecall;

2. Вычисление площади боковой поверхности бочки:
function bochka_area_bok(R, H: Single; out area: Single): HResult; safecall;

R, H – входные параметры; area – выходной параметр.

3. Вычисление площади основания бочки:
function bochka_area_osn(R: Single; out area: Single): HResult; safecall;

4. Вычисление полной площади бочки:
function bochka_area_pol(R, H: Single; out area: Single): HResult; safecall;

5. Вычисление объема, боковой, основания и полной площади поверхности бочки:
function bochka(R, H: Single; out area_osn, area_bok, area_full,ob: Single): HResult; safecall;

3.2. Рассмотрим методы интерфейса ITriangle:

Код итрефейса ITriangle

ITriangle = interface(IDispatch)
[‘{39FD3746-D5EA-44FC-BCA2-F3A0B816D0FE}’]
function triangle_per(A: Single; B: Single; out per: Single): HResult; safecall;
function triangle_area(A: Single; B: Single; out area: Single): HResult; safecall;
function Triangle(A: Single; B: Single; out area: Single; out per: Single): HResult; safecall;
end;

6. Вычисление периметра прямоугольного треугольника:
function triangle_per(A, B: Single; out value: Single): HResult; safecall;

7. Вычисление площади прямоугольного треугольника:
function triangle_area(A, B: Single; out area: Single): HResult; safecall;

8. Вычисление площади и периметра прямоугольного треугольника:
function triangle(A, B: Single; out area, per: Single): HResult; safecall;

3.3. Описание классов TBochka и TTriangle, реализующих интерфейсы:

type
TBochka = class(TAutoObject, IBochka)
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
protected
function bochka_ob(R, H: Single; out value: Single): HResult; safecall;
function bochka(R, H: Single; out area_osn, area_bok, area_full,
ob: Single): HResult; safecall;
function bochka_area_bok(R, H: Single; out area: Single): HResult;
safecall;
function bochka_area_osn(R: Single; out area: Single): HResult; safecall;
function bochka_area_pol(R, H: Single; out area: Single): HResult;
safecall;
end;

TTriangle = class(TAutoObject, ITriangle)
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
protected
function triangle(A, B: Single; out area, per: Single): HResult; safecall;
function triangle_area(A, B: Single; out area: Single): HResult; safecall;
function triangle_per(A, B: Single; out value: Single): HResult; safecall;
end;

4. Сервер автоматизации:

В соответствии с ТЗ, сервер – выделенный (out-of-process); представляет собой приложение с именем OLE_SRV.exe. На сервере отображается количество созданных объектов. Он автоматически регистрируется в реестре после первого запуска. Для удаления записей из реестра надо запустить unreg.reg (его код приведен в ниже, в п.7).

Сервер содержит один объект класса TBochka, который реализует интерфейс IBochka. А другой объект класса TTriangle, который реализует интерфейс ITriangle. Реализация методов интерфейсов проведена в модуле UnitServ.pas.

5. Контроллер автоматизации (клиент):

Клиент представляет собой приложение с именем CClient.exe. Для создания объекта «бочка» или «прямоугольный треугольник» необходимо нажать на соответствующую кнопку «Создать» при этом будет инициализирован сервер.
Пока не создан объект, кнопки для расчетов параметров геометрических фигур будут заблокированы.

Объявление указателя на интерфейс
Указатели на интерфейсы объявлены как поля в разделе public описания класса TForm1, потому что в данном случае объявлять указатели локально не имеет смысла, т.к. при вызове отдельных методов V, area_osn, area_bok, area_full, area, perimeter придется каждый раз инициализировать соответствующий указатель, а глобально не объявляем указатель в целях безопасности. Все методы объекта автоматизации на сервере вызываются при помощи указателей на интерфейсы.

TForm1 = class(TForm)
…
Public
pBochka: IBochkaDisp;
pTriangle: ITriangleDisp;
…
End;

Инициализация осуществляется с помощью метода Create класса TComponent, автоматически создаваемого библиотекой типов.

pBochka:=CoBochka.Create as IBochkaDisp;
pTriangle:=CoTriangle.Create as ITriangleDisp;

CoClass инкапсулирует методы Delphi по созданию объектов, и ввиду
простоты является наиболее удобным в данном случае.

6. Обработка ошибок

I. На стороне сервера:
Осуществляется проверка полученных значений аргументов на нуль.
(используется оператор ветвления if и возвращается код ошибки E_INVALIDARG).
Проверяется недостаток памяти – используется конструкция try… except… end. Возвращается код ошибки E_OUTOFMEMORY.
При успешном завершении расчёта возвращается S_OK.

II. На стороне клиента:
Обрабатывается ввод некорректных данных – например, текста. Используется конструкция try… except… end; с on… do.
Обработка данного типа ошибок (EConvertError) выведена на клиент, так как возникнуть может только на нём.

Так же обрабатывается ввод отрицательных значений используется оператор ветвления if:

7. Регистрация сервера

Сервер выполнен в виде отдельного процесса (exe), он «саморегистрирующийся». Ниже приведён список ключей, который сервер заносит в системный реестр.

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\CLSID\{00EA413B-6323-494A-996D-1C959319773D}]
@=»Geometry Object»

[HKEY_CLASSES_ROOT\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\LocalServer32]
@=»C:\\DOCUME~1\\86A9~1\\C316~1\\Delphi\\OLE_SU~1\\OLE_SRV.exe»

[HKEY_CLASSES_ROOT\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\ProgID]
@=»OLE_SRV.Bochka»

[HKEY_CLASSES_ROOT\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\TypeLib]
@=»{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}»

[HKEY_CLASSES_ROOT\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\Version]
@=»1.0″

[HKEY_CLASSES_ROOT\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}]
@=»»

[HKEY_CLASSES_ROOT\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\LocalServer32]
@=»C:\\DOCUME~1\\86A9~1\\C316~1\\Delphi\\OLE_SU~1\\OLE_SRV.exe»

[HKEY_CLASSES_ROOT\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\ProgID]
@=»OLE_SRV.Triangle»

[HKEY_CLASSES_ROOT\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\TypeLib]
@=»{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}»

[HKEY_CLASSES_ROOT\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\Version]
@=»1.0″

[HKEY_CLASSES_ROOT\OLE_SRV.Bochka]
@=»Geometry Object»

[HKEY_CLASSES_ROOT\OLE_SRV.Bochka\Clsid]
@=»{00EA413B-6323-494A-996D-1C959319773D}»

[HKEY_CLASSES_ROOT\OLE_SRV.Triangle]
@=»»

[HKEY_CLASSES_ROOT\OLE_SRV.Triangle\Clsid]
@=»{EF998C55-67F6-4CAB-83D5-2DD90E263567}»

[HKEY_CLASSES_ROOT\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}]

[HKEY_CLASSES_ROOT\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0]
@=»OLE_SRV Library»

[HKEY_CLASSES_ROOT\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\0]

[HKEY_CLASSES_ROOT\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\0\win32]
@=»C:\\Documents and Settings\\Андрей\\Мои документы\\Delphi\\OLE_SUPER_NEW\\OLE_SRV.exe»

[HKEY_CLASSES_ROOT\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\FLAGS]
@=»0″

[HKEY_CLASSES_ROOT\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\HELPDIR]
@=»C:\\Documents and Settings\\Андрей\\Мои документы\\Delphi\\OLE_SUPER_NEW\\»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{00EA413B-6323-494A-996D-1C959319773D}]
@=»Geometry Object»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\LocalServer32]
@=»C:\\DOCUME~1\\86A9~1\\C316~1\\Delphi\\OLE_SU~1\\OLE_SRV.exe»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\ProgID]
@=»OLE_SRV.Bochka»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\TypeLib]
@=»{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{00EA413B-6323-494A-996D-1C959319773D}\Version]
@=»1.0″

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}]
@=»»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\LocalServer32]
@=»C:\\DOCUME~1\\86A9~1\\C316~1\\Delphi\\OLE_SU~1\\OLE_SRV.exe»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\ProgID]
@=»OLE_SRV.Triangle»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\TypeLib]
@=»{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}\Version]
@=»1.0″

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\OLE_SRV.Bochka]
@=»Geometry Object»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\OLE_SRV.Bochka\Clsid]
@=»{00EA413B-6323-494A-996D-1C959319773D}»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\OLE_SRV.Triangle]
@=»»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\OLE_SRV.Triangle\Clsid]
@=»{EF998C55-67F6-4CAB-83D5-2DD90E263567}»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}]

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0]
@=»OLE_SRV Library»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\0]

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\0\win32]
@=»C:\\Documents and Settings\\Андрей\\Мои документы\\Delphi\\OLE_SUPER_NEW\\OLE_SRV.exe»

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\FLAGS]
@=»0″

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}\1.0\HELPDIR]
@=»C:\\Documents and Settings\\Андрей\\Мои документы\\Delphi\\OLE_SUPER_NEW\\»

Для удаления сервера из системы (отмены регистрации) надо удалить записанные сервером ветки реестра. Автоматизируем процесс очистки реестра при помощи созданного файла unreg.reg. Данный способ является самым простым и универсальным.

unreg.reg:

Windows Registry Editor Version 5.00

[-HKEY_CLASSES_ROOT\CLSID\{00EA413B-6323-494A-996D-1C959319773D}]

[-HKEY_CLASSES_ROOT\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}]

[-HKEY_CLASSES_ROOT\OLE_SRV.Bochka]

[-HKEY_CLASSES_ROOT\OLE_SRV.Triangle]

[-HKEY_CLASSES_ROOT\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}]

[-HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{00EA413B-6323-494A-996D-1C959319773D}]

[-HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{EF998C55-67F6-4CAB-83D5-2DD90E263567}]

[-HKEY_LOCAL_MACHINE\SOFTWARE\Classes\OLE_SRV.Bochka]

[-HKEY_LOCAL_MACHINE\SOFTWARE\Classes\OLE_SRV.Triangle]

[-HKEY_LOCAL_MACHINE\SOFTWARE\Classes\TypeLib\{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}]

8. Код приложения на Delphi

program OLE_SRV;

uses
Forms,
Server in ‘Server.pas’ {Form1},
OLE_SRV_TLB in ‘OLE_SRV_TLB.pas’,
UnitServ in ‘UnitServ.pas’ {Geometry: CoClass};

{$R *.TLB}

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

OLE_SRV_TLB.pas:
unit OLE_SRV_TLB;

// ************************************************************************ //
// WARNING
// ——-
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// ‘Refresh’ command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 10.05.2009 1:18:36 from Type Library described below.

// ************************************************************************ //
// Type Lib: C:\Documents and Settings\??????\??? ?????????\Delphi\OLE_SUPER_NEW\OLE_SRV.tlb (1)
// LIBID: {34F5A376-3DCF-468F-BEBF-163D7D9FB49F}
// LCID: 0
// Helpfile:
// HelpString: OLE_SRV Library
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
OLE_SRVMajorVersion = 1;
OLE_SRVMinorVersion = 0;

LIBID_OLE_SRV: TGUID = ‘{34F5A376-3DCF-468F-BEBF-163D7D9FB49F}’;

IID_IBochka: TGUID = ‘{29614A10-D147-4F10-B93E-E1E6C8CA57EB}’;
IID_ITriangle: TGUID = ‘{39FD3746-D5EA-44FC-BCA2-F3A0B816D0FE}’;
CLASS_Bochka: TGUID = ‘{00EA413B-6323-494A-996D-1C959319773D}’;
CLASS_Triangle: TGUID = ‘{EF998C55-67F6-4CAB-83D5-2DD90E263567}’;
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IBochka = interface;
IBochkaDisp = dispinterface;
ITriangle = interface;
ITriangleDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
Bochka = IBochka;
Triangle = ITriangle;

// *********************************************************************//
// Interface: IBochka
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {29614A10-D147-4F10-B93E-E1E6C8CA57EB}
// *********************************************************************//
IBochka = interface(IDispatch)
[‘{29614A10-D147-4F10-B93E-E1E6C8CA57EB}’]
function bochka_ob(R: Single; H: Single; out value: Single): HResult; safecall;
function bochka_area_osn(R: Single; out area: Single): HResult; safecall;
function bochka_area_bok(R: Single; H: Single; out area: Single): HResult; safecall;
function bochka_area_pol(R: Single; H: Single; out area: Single): HResult; safecall;
function Bochka(R: Single; H: Single; out area_osn: Single; out area_bok: Single;
out area_full: Single; out ob: Single): HResult; safecall;
end;

// *********************************************************************//
// DispIntf: IBochkaDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {29614A10-D147-4F10-B93E-E1E6C8CA57EB}
// *********************************************************************//
IBochkaDisp = dispinterface
[‘{29614A10-D147-4F10-B93E-E1E6C8CA57EB}’]
function bochka_ob(R: Single; H: Single; out value: Single): HResult; dispid 201;
function bochka_area_osn(R: Single; out area: Single): HResult; dispid 202;
function bochka_area_bok(R: Single; H: Single; out area: Single): HResult; dispid 203;
function bochka_area_pol(R: Single; H: Single; out area: Single): HResult; dispid 204;
function Bochka(R: Single; H: Single; out area_osn: Single; out area_bok: Single;
out area_full: Single; out ob: Single): HResult; dispid 205;
end;

// *********************************************************************//
// Interface: ITriangle
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {39FD3746-D5EA-44FC-BCA2-F3A0B816D0FE}
// *********************************************************************//
ITriangle = interface(IDispatch)
[‘{39FD3746-D5EA-44FC-BCA2-F3A0B816D0FE}’]
function triangle_per(A: Single; B: Single; out per: Single): HResult; safecall;
function triangle_area(A: Single; B: Single; out area: Single): HResult; safecall;
function Triangle(A: Single; B: Single; out area: Single; out per: Single): HResult; safecall;
end;

// *********************************************************************//
// DispIntf: ITriangleDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {39FD3746-D5EA-44FC-BCA2-F3A0B816D0FE}
// *********************************************************************//
ITriangleDisp = dispinterface
[‘{39FD3746-D5EA-44FC-BCA2-F3A0B816D0FE}’]
function triangle_per(A: Single; B: Single; out per: Single): HResult; dispid 206;
function triangle_area(A: Single; B: Single; out area: Single): HResult; dispid 207;
function Triangle(A: Single; B: Single; out area: Single; out per: Single): HResult; dispid 208;
end;

// *********************************************************************//
// The Class CoBochka provides a Create and CreateRemote method to
// create instances of the default interface IBochka exposed by
// the CoClass Bochka. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoBochka = class
class function Create: IBochka;
class function CreateRemote(const MachineName: string): IBochka;
end;

// *********************************************************************//
// The Class CoTriangle provides a Create and CreateRemote method to
// create instances of the default interface ITriangle exposed by
// the CoClass Triangle. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoTriangle = class
class function Create: ITriangle;
class function CreateRemote(const MachineName: string): ITriangle;
end;

implementation

uses ComObj;

class function CoBochka.Create: IBochka;
begin
Result := CreateComObject(CLASS_Bochka) as IBochka;
end;

class function CoBochka.CreateRemote(const MachineName: string): IBochka;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Bochka) as IBochka;
end;

class function CoTriangle.Create: ITriangle;
begin
Result := CreateComObject(CLASS_Triangle) as ITriangle;
end;

class function CoTriangle.CreateRemote(const MachineName: string): ITriangle;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Triangle) as ITriangle;
end;

end.

UnitServ.pas – реализация методов интерфейсов:
unit UnitServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
ComObj, ActiveX, OLE_SRV_TLB, StdVcl, Server, SysUtils, Math, Windows;

type
TBochka = class(TAutoObject, IBochka)
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
protected
function bochka_ob(R, H: Single; out value: Single): HResult; safecall;
function bochka(R, H: Single; out area_osn, area_bok, area_full,
ob: Single): HResult; safecall;
function bochka_area_bok(R, H: Single; out area: Single): HResult;
safecall;
function bochka_area_osn(R: Single; out area: Single): HResult; safecall;
function bochka_area_pol(R, H: Single; out area: Single): HResult;
safecall;
end;

TTriangle = class(TAutoObject, ITriangle)
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
protected
function triangle(A, B: Single; out area, per: Single): HResult; safecall;
function triangle_area(A, B: Single; out area: Single): HResult; safecall;
function triangle_per(A, B: Single; out value: Single): HResult; safecall;
end;
implementation

uses ComServ;

function TBochka.bochka_ob(R, H: Single; out value: Single): HResult;
begin
if(R=0.0)or(H=0.0)then
begin
value:=0;
Result:=E_INVALIDARG;
end
else
begin
try
value:=pi*R*R*h;
Result:=S_OK
except
Result:=E_OUTOFMEMORY;
value:=0;
end;
end;
end;

function TTriangle.triangle_per(A, B: Single; out value: Single): HResult;
begin
if(A=0.0)or(B=0.0)then
begin
value:=0;
Result:=E_INVALIDARG;
end
else
begin
try
value:=A+B+sqrt(A*A+B*B);
Result:=S_OK
except
Result:=E_OUTOFMEMORY;
value:=0;
end;
end;
end;

function TBochka.bochka(R, H: Single; out area_osn, area_bok, area_full,
ob: Single): HResult;
begin
if(R=0.0)or(H=0.0)then
begin
area_bok:=0;
area_osn:=0;
area_full:=0;
ob:=0;
Result:=E_INVALIDARG;
end
else
begin
try
area_bok:=2*pi*R*h;
area_osn:=pi*R*R;
area_full:=area_bok+2*area_osn;
ob:=pi*R*R*h;
Result:=S_OK;
except
Result:=E_OUTOFMEMORY;
area_bok:=0;
area_osn:=0;
area_full:=0;
ob:=0;
end;
end;
end;

function TBochka.bochka_area_bok(R, H: Single;
out area: Single): HResult;
begin
if(R=0.0)or(H=0.0)then
begin
area:=0;
Result:=E_INVALIDARG;
end
else
begin
try
area:=2*pi*R*h;
Result:=S_OK;
except
Result:=E_OUTOFMEMORY;
area:=0;
end;
end;
end;

function TBochka.bochka_area_osn(R: Single; out area: Single): HResult;
begin
if(R=0.0)then
begin
area:=0;
Result:=E_INVALIDARG;
end
else
begin
try
area:=pi*R*R;
Result:=S_OK;
except
Result:=E_OUTOFMEMORY;
area:=0;
end;
end;
end;

function TBochka.bochka_area_pol(R, H: Single;
out area: Single): HResult;
begin
if(R=0.0)or(H=0.0)then
begin
area:=0;
Result:=E_INVALIDARG;
end
else
begin
try
area:=2*pi*R*R+2*pi*R*h;
Result:=S_OK;
except
Result:=E_OUTOFMEMORY;
area:=0;
end;
end;
end;

function TTriangle.triangle(A, B: Single; out area, per: Single): HResult;
begin
if(A=0.0)or(B=0.0)then
begin
area:=0;
per:=0;
Result:=E_INVALIDARG;
end
else
begin
try
area:=0.5*A*B;
per:=A+B+sqrt(A*A+B*B);
Result:=S_OK;
except
Result:=E_OUTOFMEMORY;
area:=0;
per:=0;
end;
end;
end;

function TTriangle.triangle_area(A, B: Single; out area: Single): HResult;
begin
if(A=0.0)or(B=0.0)then
begin
area:=0;
Result:=E_INVALIDARG;
end
else
begin
try
area:=0.5*A*B;
Result:=S_OK;
except
Result:=E_OUTOFMEMORY;
area:=0;
end;
end;
end;

procedure TBochka.AfterConstruction;
begin
Form1.Label1.Caption:=IntToStr(StrToInt(Form1.Label1.Caption)+1);
Inherited AfterConstruction;
end;

procedure TBochka.BeforeDestruction;
begin
Form1.Label1.Caption:=IntToStr(StrToInt(Form1.Label1.Caption)-1);
Inherited BeforeDestruction;
end;

procedure TTriangle.AfterConstruction;
begin
Form1.Label3.Caption:=IntToStr(StrToInt(Form1.Label3.Caption)+1);
Inherited AfterConstruction;
end;

procedure TTriangle.BeforeDestruction;
begin
Form1.Label3.Caption:=IntToStr(StrToInt(Form1.Label3.Caption)-1);
Inherited BeforeDestruction;
end;

initialization
TAutoObjectFactory.Create(ComServer, TBochka, Class_Bochka,
ciMultiInstance, tmApartment);
TAutoObjectFactory.Create(ComServer, TTriangle, Class_Triangle,
ciMultiInstance, tmApartment);
end.

Код клиента:

unit CLIENT;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, GIFImage, jpeg, ExtCtrls, StdCtrls, OLE_SRV_TLB, ComObj;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button1: TButton;
Button7: TButton;
Button8: TButton;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Edit3: TEdit;
Edit4: TEdit;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Label11: TLabel;
Label12: TLabel;
Button12: TButton;
Button13: TButton;
procedure Button1Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
private
{ Private declarations }
public
pBochka:IBochkaDisp;
pTriangle:ITriangleDisp;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
try
pBochka:=CoBochka.Create as IBochkaDisp;
Button2.Enabled:=true;
Button3.Enabled:=true;
Button4.Enabled:=true;
Button5.Enabled:=true;
Button6.Enabled:=true;
except
ShowMessage(‘Невозможно соединиться с сервером’);
end;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
pBochka:=nil;
Button2.Enabled:=false;
Button3.Enabled:=false;
Button4.Enabled:=false;
Button5.Enabled:=false;
Button6.Enabled:=false;
end;

procedure TForm1.Button2Click(Sender: TObject);
var Result: HRESULT; R, H, S_osn, S_bok, S_full, ob: Single;
begin
try
R:=StrToFloat(Edit1.Text);
H:=StrToFloat(Edit2.Text);
if(R<0)or(H<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pBochka.Bochka(R,H, S_osn, S_bok, S_full, ob); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ShowMessage ('Сервер сообщает об ошибке: не хватает памяти'); Label5.Caption:=FloatToStrf(ob,ffFixed,10,5); Label6.Caption:=FloatToStrf(S_osn,ffFixed,10,5); Label7.Caption:=FloatToStrf(S_bok,ffFixed,10,5); Label8.Caption:=FloatToStrf(S_full,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; procedure TForm1.Button8Click(Sender: TObject); begin Close; end; procedure TForm1.Button3Click(Sender: TObject); var Result: HRESULT; R, H, ob: Single; begin try R:=StrToFloat(Edit1.Text); H:=StrToFloat(Edit2.Text); if(R<0)or(H<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pBochka.bochka_ob(R,H,ob); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ShowMessage ('Сервер сообщает об ошибке: не хватает памяти'); Label5.Caption:=FloatToStrf(ob,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; procedure TForm1.Button4Click(Sender: TObject); var Result: HRESULT; R, area_osn: Single; begin try R:=StrToFloat(Edit1.Text); if(R<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pBochka.bochka_area_osn(R,area_osn); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ShowMessage ('Сервер сообщает об ошибке: не хватает памяти'); Label6.Caption:=FloatToStrf(area_osn,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; procedure TForm1.Button5Click(Sender: TObject); var Result: HRESULT; R, H, area_bok: Single; begin try R:=StrToFloat(Edit1.Text); H:=StrToFloat(Edit2.Text); if(R<0)or(H<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pBochka.bochka_area_bok(R,H,area_bok); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ShowMessage ('Сервер сообщает об ошибке: не хватает памяти'); Label7.Caption:=FloatToStrf(area_bok,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; procedure TForm1.Button6Click(Sender: TObject); var Result: HRESULT; R, H, area_full: Single; begin try R:=StrToFloat(Edit1.Text); H:=StrToFloat(Edit2.Text); if(R<0)or(H<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pBochka.bochka_area_pol(R,H,area_full); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ShowMessage ('Сервер сообщает об ошибке: не хватает памяти'); Label8.Caption:=FloatToStrf(area_full,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; procedure TForm1.Button12Click(Sender: TObject); begin try pTriangle:=CoTriangle.Create as ITriangle; Button9.Enabled:=true; Button10.Enabled:=true; Button11.Enabled:=true; except ShowMessage('Невозможно соединиться с сервером');end; end; procedure TForm1.Button13Click(Sender: TObject); begin pTriangle:=nil; Button9.Enabled:=false; Button10.Enabled:=false; Button11.Enabled:=false; end; procedure TForm1.Button9Click(Sender: TObject); var Result: HRESULT; A, B, area, per: Single; begin try A:=StrToFloat(Edit3.Text); B:=StrToFloat(Edit4.Text); if(A<0)or(B<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pTriangle.triangle(A, B, area, per); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ShowMessage ('Сервер сообщает об ошибке: не хватает памяти'); Label11.Caption:=FloatToStrf(area,ffFixed,10,5); Label12.Caption:=FloatToStrf(per,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; procedure TForm1.Button10Click(Sender: TObject); var Result: HRESULT; A, B, area: Single; begin try A:=StrToFloat(Edit3.Text); B:=StrToFloat(Edit4.Text); if(A<0)or(B<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pTriangle.triangle_area(A, B, area); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ShowMessage ('Сервер сообщает об ошибке: не хватает памяти'); Label11.Caption:=FloatToStrf(area,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; procedure TForm1.Button11Click(Sender: TObject); var Result: HRESULT; A, B, per: Single; begin try A:=StrToFloat(Edit3.Text); B:=StrToFloat(Edit4.Text); if(A<0)or(B<0) then ShowMessage('Данные должны быть неотрицательными') else begin Result:=pTriangle.triangle_per(A, B, per); if Result=S_OK then ShowMessage ('Расчет успешно завершен') else if Result=E_INVALIDARG then ShowMessage ('Сервер сообщает об ошибке: один или два переданных параметра равны нулю') else if Result=E_OUTOFMEMORY then ('Сервер сообщает об ошибке: не хватает памяти'); Label12.Caption:=FloatToStrf(per,ffFixed,10,5); end; except On EConvertError Do ShowMessage ('Некорректные входные данные'); end; end; end.

Комментарии запрещены.