Главная » Delphi » События с несколькими стоками

0

Хотя описанная выше методика прекрасно работает при  генерации событий, предназначенных для одного  клиента, она не так уж хороша при  работе с нескольки ми клиентами. Однако  ситуации подключения к серверу  нескольких клиентов возни кают довольно часто,  и в этом случае необходимо генерировать события для всех кли ентов.  К счастью, для этого  потребуется добавить лишь несколько строк  кода. Чтобы создать  события для нескольких клиентов, нужно  написать код,  опрашивающий все имеющиеся подключения и вызывающий соответствующий метод  стока.  Это  можно реализовать, внеся несколько изменений в предыдущий пример.

Пойдем по  порядку.  Чтобы поддерживать несколько подключений, необходимо в качестве  параметра  Kind метода   TConnectionPoints.CreateConnectionPoint() передать значение ckMulti. Этот  метод  вызывается из метода  Initialize() объекта автоматизации:

FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID, ckMulti, EventConnect);Перед построением перечня подключений нужно  получить ссылку на интерфейс IConnectionPointContainer.  Из   интерфейса  IConnectionPointContainer можно  получить интерфейс IConnectionPoint, представляющий собой  исходящий интерфейс, а  с  помощью метода  IConnectionPoint.EnumConnections() можно получить интерфейс IEnumConnections, который будет использоваться для по строения перечня подключений. Вся эта логика “укладывается” в следующем методе:

function TServerWithEvents.GetConnectionEnumerator: IEnumConnec- tions;

var

Container: IConnectionPointContainer;

CP: IConnectionPoint;

begin

Result := nil;

OleCheck(QueryInterface(IConnectionPointContainer, Container));

OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID,

CP));

CP.EnumConnections(Result);

end;

Получив перечень подключений интерфейса для каждого из клиентов, осуществляется вызов  его стока последовательным перебором всех установленных подключений. Эта ло гика демонстрируется в следующем коде, который передает событие OnTextChanged():

procedure TServerWithEvents.MemoChange(Sender: TObject);

var

EC: IEnumConnections;

ConnectData: TConnectData;

Fetched: Cardinal;

begin

EC := GetConnectionEnumerator;

if EC <> nil then begin

while EC.Next(1, ConnectData, @Fetched) = S_OK do

if ConnectData.pUnk <> nil then

(ConnectData.pUnk as

IServerWithEventsEvents).OnTextChanged(

(Sender as TMemo).Text);

end;

end;

Наконец, чтобы  позволить клиентам подключиться к единственному объекту  ав томатизации, необходимо вызвать функцию API COM RegisterActiveObject(). Этой  функции передаются следующие  параметры: интерфейс IUnknown для объекта, идентификатор класса  объекта (CLSID),  флаг  строгой регистрации (строгая регист рация подразумевает наличие у сервера метода  AddRef, а нестрогая допускает  его от сутствие) и дескриптор, который возвращается по ссылке:

RegisterActiveObject(Self as IUnknown, Class_ServerWithEvents, ACTIVEOBJECT_WEAK, FObjRegHandle);

Все эти программные фрагменты связываются  воедино  в  модуле  ServAuto,  пол

ный исходный код которого представлен в листинге 15.10.

Листинг 15.10. Модуль ServAuto.pas

unit ServAuto;

interface uses

ComObj, ActiveX, AxCtrls, Server_TLB;

type

TServerWithEvents = class(TAutoObject,

IConnectionPointContainer,

IServerWithEvents)

private

{ Закрытые объявления }

FConnectionPoints: TConnectionPoints;

FObjRegHandle: Integer;

procedure MemoChange(Sender: TObject);

protected

{ Защищенные объявления }

procedure AddText(const NewText: WideString); safecall;

procedure Clear; safecall;

function GetConnectionEnumerator: IEnumConnections;

property ConnectionPoints: TConnectionPoints

read FConnectionPoints

implements IConnectionPointContainer;

public

destructor Destroy; override;

procedure Initialize; override;

end;

implementation

uses Windows, ComServ, ServMain, SysUtils, StdCtrls;

destructor TServerWithEvents.Destroy;

begin

inherited Destroy;

// Удаление объекта из таблицы ROT

RevokeActiveObject(FObjRegHandle, nil);

end;

procedure TServerWithEvents.Initialize;

begin

inherited Initialize;

FConnectionPoints := TConnectionPoints.Create(Self);

if AutoFactory.EventTypeInfo <> nil then

FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,

ckMulti, EventConnect);

// Направить событие OnChange поля memo главной

// формы методу MemoChange:

MainForm.Memo.OnChange := MemoChange;

// Зарегистрировать этот объект с помощью

// таблицы ROT (Running Object Table), чтобы другие клиенты

// могли подключиться к этому экземпляру.

RegisterActiveObject(Self as IUnknown, Class_ServerWithEvents,

ACTIVEOBJECT_WEAK, FObjRegHandle);end;

procedure TServerWithEvents.Clear;

var

EC: IEnumConnections;

ConnectData: TConnectData;

Fetched: Cardinal;

begin

MainForm.Memo.Lines.Clear;

EC := GetConnectionEnumerator;

if EC <> nil then begin

while EC.Next(1, ConnectData, @Fetched) = S_OK do

if ConnectData.pUnk <> nil then

(ConnectData.pUnk as IServerWithEventsEvents).OnClear;

end;

end;

procedure TServerWithEvents.AddText(const NewText: WideString);

begin

MainForm.Memo.Lines.Add(NewText);

end;

procedure TServerWithEvents.MemoChange(Sender: TObject);

var

EC: IEnumConnections;

ConnectData: TConnectData;

Fetched: Cardinal;

begin

EC := GetConnectionEnumerator;

if EC <> nil then begin

while EC.Next(1, ConnectData, @Fetched) = S_OK do

if ConnectData.pUnk <> nil then

(ConnectData.pUnk as

IServerWithEventsEvents).OnTextChanged(((Sender as

TMemo).Text);

end;

end;

function TServerWithEvents.GetConnectionEnumerator:?

IEnumConnections;

var

Container: IConnectionPointContainer;

CP: IConnectionPoint;

begin

Result := nil;

OleCheck(QueryInterface(IConnectionPointContainer, Container));

OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID,

CP));

CP.EnumConnections(Result);

end;

initialization

TAutoObjectFactory.Create(ComServer, TServerWithEvents,

Class_ServerWithEvents,

ciMultiInstance, tmApartment);

end.В программное обеспечение клиентов также  нужно внести небольшие изменения, чтобы  позволить клиентам подключаться к активному экземпляру, если  он уже запу щен. Эти действия реализованы с помощью  функции API COM GetActiveObject():

procedure TMainForm.FormCreate(Sender: TObject);

var

ActiveObj: IUnknown;

begin

// Получить активный объект, если он доступен, в противном

// случае создать новый

GetActiveObject(Class_ServerWithEvents, nil, ActiveObj);

if ActiveObj <> nil then

FServer := ActiveObj as IServerWithEvents

else

FServer := CoServerWithEvents.Create;

FEventSink := TEventSink.Create(Self);

InterfaceConnect(FServer, IServerWithEventsEvents,

FEventSink, FCookie);

end;

На  рис. 15.15  показаны клиенты, принимающие события от одного  единственного сервера.

Рис. 15.15. Несколько клиентов, манипулирующих одним и тем же сервером и принимают его события

Источник: Тейксейра, Стив, Пачеко, Ксавье.   Borland Delphi 6. Руководство разработчика. : Пер.  с англ. — М. : Издательский дом “Вильямс”, 2002. —  1120 с. : ил. — Парал. тит. англ.

По теме:

  • Комментарии