Обратные вызовы в MIDAS через TSocketConnection

Обратные вызовы в MIDAS через TSocketConnection

Передача сообщений между клиентскими приложениями

Роман Игнатьев (Romkin)

Введение

Обратные вызовы в технологии СОМ – достаточно обычное дело. Клиент подключается к серверу, и сервер в некоторых случаях извещает клиента о событиях, происходящих в системе, просто вызывая методы интерфейса обратного вызова. Однако реализация механизма для TRemoteDataModule, который обычно применяется на сервере приложений, довольно загадочна. В этой статье как раз и описывается способ реализации вызовов клиентской части со стороны сервера приложений.

Все началось с того, что я обновил Delphi с 4 на 5 версию, и при этом обнаружил, что у TSocketConnection появилось свойство SupportCallbacks. В справочной системе написано, что при установке этого свойства в True сервер приложений может делать обратные вызовы методов клиента, и больше практически никаких подробностей. При этом возможность добавить поддержку обратных вызовов при создании Remote data module отсутствует, и не совсем ясно, как же реализовывать обратные вызовы клиента в этом случае. С одной стороны, способность сервера приложений извещать своих клиентов о каких-либо событиях очень привлекательна, с другой стороны – без этого как-то до сих пор обходились.

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

Итак, что же мне хотелось сделать. Мне хотелось сделать механизм, позволяющий серверу приложений посылать сообщения всем подключенным к нему клиентам, а заодно дать возможность одной клиентской части вызывать методы других клиентских частей, например, для организации простого обмена сообщениями. Как видно, вторая задача включает в себя первую, ведь если сервер приложений знает, как посылать сообщения всем клиентам, достаточно просто выделить эту процедуру в отдельный метод интерфейса, и любое клиентское приложение сможет делать то же самое. Поскольку обычно я работаю с серверами приложений, удаленные модули данных в которых работают по модели Apartment (в фабрике класса стоит параметр tmApartment), мне хотелось сделать метод, работающий именно в этой модели. Как будет видно ниже, это связано с некоторыми сложностями.

После нескольких попыток реализовать обратные вызовы, написав при этом как можно меньше кода, и при этом еще понять, что же именно делается, выяснилось следующее:

Писать все пришлось вручную, стандартные механизмы обратных вызовов заставить работать мне не удалось. Как известно, при реализации обратного вызова клиентская часть просто неявно создает кокласс для реализации интерфейса обратного вызова, и передает ссылку на его интерфейс COM-серверу, который по мере надобности вызывает его методы. Этого же результата можно добиться, написав объект автоматизации на клиенте и передав его интерфейс серверу. Ниже так и сделано.

К сожалению, при модели Apartment каждый удаленный модуль данных работает в своем потоке, а просто так вызвать интерфейс из другого потока невозможно, и необходимо производить ручной маршалинг или пользоваться GIT. Такой механизм в COM есть, со способом вызова можно ознакомиться, например, на http://www.techvanguards.com/com/tutorials/tips.asp#Marshal%20interface%20pointers%20across%20apartments (на нашем сайте вы можете найти разбор тех же вопросов на русском языке). Мне так делать не захотелось, во-первых, это достаточно сложно и я оставил это "на сладкое", во-вторых, я попробовал маршалинг через механизм сообщений, что позволяет реализовать как синхронные вызовы, так и асинхронные. Вызывающий модуль в этом случае не ожидает обработки вызовов клиентами, что, как мне кажется, является дополнительным преимуществом. Впрочем, при стандартном маршалинге реализуется практически такой же механизм.

Вот что у меня получилось в итоге.

Сервер приложений

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

В библиотеке типов надо объявить собственно интерфейс обратного вызова, который станет известен клиентской части при импорте библиотеки типов сервера.

В результате библиотека типов приняла вид, приведенный на рисунке 1.



Рисунок 1.

Проект называется BkServer. Модуль данных называется rdmMain, и в его интерфейсе объявлены методы, описание которых приведено ниже.

procedure RegisterCallBack(const BackCallIntf: IDispatch); safecall;

В данный метод должен передаваться интерфейс обратного вызова IBackCall, метод OnCall которого и служит для обеспечения обратного вызова. Однако параметр объявлен как IDispatch, с другими типами соединение по сокетам просто не работает.

procedure Broadcast(const MsgStr: WideString); safecall;

Этот метод служит для широковещательной рассылки сообщений.

В интерфейсе обратного вызова (IBackCall) есть только один метод:

procedure OnCall(const MsgStr: WideString); safecall;

Этот метод получает сообщение.

Полученные клиентские интерфейсы надо где-то хранить, причем желательно обеспечить к ним доступ из глобального списка, тогда сообщение можно передать всем клиентским частям, просто пройдя по этому списку. Мне показалось удобным сделать класс-оболочку, и вставлять в список ссылку на класс. В качестве списка используется простой TThreadList, описанный как глобальная переменная в секции implementation:

var CallbackList: TThreadList;

и, соответственно, экземпляр списка создается в секции initialization модуля и освобождается при завершении работы приложения в секции finalization. Выбран именно TThreadList (потокобезопасный список), поскольку, как уже упоминалось, используется модель apartment, и обращения к списку будут идти из разных потоков.

В секции initialization записано следующее объявление фабрики класса:

TComponentFactory.Create(ComServer, TrdmMain, Class_rdmMain, ciMultiInstance, tmApartment);

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

В CallbackList хранятся ссылки на класс TCallBackStub, в котором и хранится ссылка на интерфейс клиента:

TCallBackStub = class(TObject)

 private

  // Callback-интерфейсы должны быть disp-интерфейсами.

  // Вызовы должны идти через Invoke

  FClientIntf: IBackCallDisp; 

  FOwner: TrdmMain;

  FCallBackWnd: HWND;

 public

  constructor Create(AOwner: TrdmMain);

  destructor Destroy; override;

  procedure CallOtherClients(const MsgStr: WideString);

  function OnCall(const MsgStr: WideString): BOOL;

  property ClientIntf: IBackCallDisp read FClientIntf write FClientIntf;

  property Owner: TrdmMain read FOwner write FOwner;

end;

Экземпляр этого класса создается и уничтожается rdmMain (в обработчиках OnCreate и OnDestroy). Ссылка на него сохраняется в переменной TrdmMain.FCallBackStub, при этом класс сразу вставляется в список:

procedure TrdmMain.RemoteDataModuleCreate(Sender: TObject);

begin

 //Сразу делаем оболочку для callback-интерфейса

 FCallbackStub := TCallBackStub.Create(Self);

 //И сразу регистрируем в общем списке

 CallbackList.Add(FCallBackStub);

end;



procedure TrdmMain.UnregisterStub;

begin

 if Assigned(FCallbackStub) then

 begin

  CallbackList.Remove(FCallbackStub);

  FCallBackStub.ClientIntf := nil;

  FCallBackStub.Free;

  FCallBackStub := nil;

 end;

end;



procedure TrdmMain.RemoteDataModuleDestroy(Sender: TObject);

begin

 UnregisterStub;

end;

Назначение полей довольно понятно: в FClientIntf хранится собственно интерфейс обратного вызова, в FOwner - ссылка на TRdmMain... А вот третье поле (FCallBackWnd) служит для маршалинга вызовов между потоками, об этом будет сказано немного ниже. В вызове метода RegisterCallBack интерфейс просто передается этому классу, где и производится непосредственный вызов callback-интерфейса (через Invoke):

procedure TrdmMain.RegisterCallBack(const BackCallIntf: IDispatch);

begin

 lock;

 try

  FCallBackStub.ClientIntf := IBackCallDisp(BackCallIntf);

 finally

  unlock;

 end;

end;

Всего этого вполне достаточно для вызовов клиентской части из удаленного модуля данных, к которому она присоединена. Однако задача состоит именно в том, чтобы вызывать интерфейсы клиентских частей, работающих с другими модулями. Это обеспечивается двумя методами класса TCallBackStub: CallOtherClients и OnCall. 

Первый метод довольно прост, и вызывается из процедуры Broadcast:

procedure TrdmMain.Broadcast(const MsgStr: WideString);

begin

 lock;

 try

  if Assigned(FCallbackStub) then //переводим стрелки :)

   FCallbackStub.CallOtherClients(MsgStr);

 finally

  unlock;

 end;

end;

procedure TCallBackStub.CallOtherClients(const MsgStr: WideString);

var

 i: Integer;

 LastError: DWORD;

 ErrList: string;

begin

 ErrList := '';

 with Callbacklist.LockList do

 try

  for i := 0 to Count - 1 do

   if Items[i] <> Self then // для всех, кроме себя

    if not TCallbackStub(Items[i]).OnCall(MsgStr) then

    begin

     LastError := GetLastError;

     if LastError <> ERROR_SUCCESS then

      ErrList := ErrList + SysErrorMessage(LastError) + #13#10

     else

      ErrList := ErrList + 'Что-то непонятное' + #13#10;

    end;

  if ErrList <> '' then

   raise Exception.Create('Возникли ошибки:'#13#10 + ErrList);

 finally

  Callbacklist.UnlockList;

 end;

end;

Организуется проход по списку Callbacklist, и для всех TCallbackStub в списке вызывается метод OnCall. Если вызов не получился, собираем ошибки и выдаем сообщение. Ошибка может быть системной, как видно ниже. Я не стал создавать свой класс исключительной ситуации, на клиенте она все равно будет выглядеть как EOLEException.

Если бы модель потоков была tmSingle, в методе OnCall достаточно было бы просто вызвать соответствующий метод интерфейса IBackCallDisp, но при создании удаленного модуля данных была выбрана модель tmApartment, и прямой вызов IBackcallDisp.OnCall немедленно приводит к ошибке, потоки-то разные. Поэтому приходится делать вызовы интерфейса из его собственного потока. Для этого используется окно, создаваемое каждым экземпляром класса TCallBackStub, handle которого и хранится в переменной FCallBackWnd. Основная идея такая: вместо прямого вызова интерфейса послать сообщение в окно, и вызвать метод интерфейса в процедуре обработки сообщений этого окна, которая обработает сообщение в контексте потока, создавшего окно:

function TCallBackStub.OnCall(const MsgStr: WideString): BOOL;

var

 MsgClass: TMsgClass;

begin

 Result := True;

 if Assigned(FClientIntf) and (FCallbackWnd <> 0) then

 begin

  //MsgClass - это просто оболочка для сообщения, здесь же можно передавать

  //дополнительную служебную информацию.

  MsgClass := TMsgClass.Create;

  //А вот освобожден объект будет в обработчике сообщения.

  MsgClass.MsgStr := MsgStr;

  //Синхронизация - послал и забыл :-)) Выходим сразу.

  //При SendMessage вызвавший клиент будет ждать, пока все остальные клиенты

  //обработают сообщение, а это нежелательно

  Result := PostMessage(FCallBackWnd, CM_CallbackMessage,

        Longint(MsgClass),Longint(Self));

  if not Result then //ну и не надо :)

   MsgClass.Free;

 end;

end;

Что получается: сообщение посылается в очередь каждого потока, и там сообщения накапливаются. Когда модуль данных освобождается от текущей обработки данных, а она может быть достаточно долгой, все сообщения в очереди обрабатываются и передаются на клиентскую часть в порядке поступления. Побочным эффектом является то, что клиент, вызвавший Broadcast, не ожидает окончания обработки сообщений всеми другими клиентскими частями, так как PostMessage возвращает управление немедленно. В итоге получается достаточно симпатичная система, когда один клиент посылает сообщение всем остальным и тут же продолжает работу, не ожидая окончания передачи. Остальные же клиенты получают это сообщение в момент, когда никакой обработки данных не происходит, возможно – гораздо позже. Класс TMsgClass объявлен в секции implementation следующим образом:

type

 TMsgClass = class(TObject)

 public

  MsgStr: WideString;

 end;

и служит просто конвертом для строки сообщения, в принципе, в него можно добавить любые другие данные. Ссылка на экземпляр этого класса сохраняется только в параметре wParam сообщения, и теоретически возможна ситуация, когда сообщение будет послано модулю, который уже уничтожается (клиент отсоединился). И, естественно, сообщение обработано не будет, и не будет уничтожен экземпляр класса TMsgClass, что приведет к утечке памяти. Исходя из этого, при уничтожении класс TCallBackStub выбирает с помощью PeekMessage все оставшиеся сообщения, и уничтожает MsgClass до уничтожения окна. FCallbackWnd создается в конструкторе TCallBackStub и уничтожается в деструкторе:

constructor TCallBackStub.Create(AOwner: TrdmMain);

var

 WindowName: string;

begin

 inherited Create;

 Owner := AOwner;

 //создаем окно синхронизации

 WindowName := 'CallbackWnd' +

  IntToStr(InterlockedExchangeAdd(@WindowCounter,1));

 FCallbackWnd :=

  CreateWindow(CallbackWindowClass.lpszClassName, PChar(WindowName), 0,

   0, 0, 0, 0, 0, 0, HInstance, nil);

end;



destructor TCallBackStub.Destroy;

var

 Msg: TMSG;

begin

 //Могут остаться сообщения - удаляем

 while PeekMessage(Msg, FCallbackWnd, CM_CallbackMessage,

     CM_CallbackMessage, PM_REMOVE) do

  if Msg.wParam <> 0 then

   TMsgClass(Msg.wParam).Free;

 DestroyWindow(FCallbackWnd);

 inherited;

end;

Разумеется, перед созданием окна нужно объявить и зарегистрировать его класс, что и сделано в секции implementation модуля. Процедура обработки сообщений окна вызывает метод OnCall интерфейса при получении сообщения CM_CallbackMessage:

var

 CM_CallbackMessage: Cardinal;



function CallbackWndProc(Window: HWND; Message: Cardinal;

  wParam, lParam: Longint): Longint; stdcall;

begin

 if Message = CM_CallbackMessage then

  with TCallbackStub(lParam) do

  begin

   Result := 0;

   try

    if wParam <> 0 then

     with TMsgClass(wParam) do

     begin

      Owner.lock;

      try

       //Непосредственный вызов интерфейса клиента

       if Assigned(ClientIntf) then

        ClientIntf.OnCall(MsgStr);

      finally

       Owner.unlock;

      end;

     end;

   except

   end;

   if wParam <> 0 then // сообщение отработано - уничтожаем

    TMsgClass(wParam).Free;

  end

 else

  Result := DefWindowProc(Window, Message, wParam, lParam);

end;

Номер сообщению CM_CallbackMessage присваивается вызовом 

RegisterWindowMessage('bkServer Callback SyncMessage');

также в секции инициализации.

Вот, собственно, и все - обратный вызов осуществляется из нужного потока. Теперь можно приступать к реализации клиентской части.

Клиентская часть

Состоит из одной формы, просто чтобы попробовать механизм передачи сообщений. На этапе разработки форма выглядит следующим образом (Рисунок 2):



Рисунок 2

Здесь присутствует TSocketConnection (scMain), которая соединяется с сервером BkServer. Кнопка "Соединиться" (btnConnect) предназначена для установки соединения, кнопка "Послать" (btnSend) – для отправки сообщения, записанного в окне редактирования (eMessage) остальным клиентским частям.

Код клиентской части довольно короток:

procedure TfrmClient.btnConnectClick(Sender: TObject);

begin

 with scMain do

  Connected := not Connected;

end;



procedure TfrmClient.btnSendClick(Sender: TObject);

var

 AServer: IrdmMainDisp;

begin

 if not scMain.Connected then

  raise Exception.Create('Нет соединения');

 AServer := IrdmMainDisp(scMain.GetServer);

 AServer.Broadcast(eMessage.Text);

end;



procedure TfrmClient.scMainAfterConnect(Sender: TObject);

var

 AServer: IrdmMainDisp;

begin

 FCallBack := TBackCall.Create;

 AServer := IrdmMainDisp(scMain.GetServer);

 AServer.RegisterCallBack(FCallBack);

 lConnect.Caption := 'Соединение установлено';

 btnConnect.Caption := 'Отключиться';

end;



procedure TfrmClient.scMainAfterDisconnect(Sender: TObject);

begin

 FCallBack := nil;

 lConnect.Caption := 'Нет соединения';

 btnConnect.Caption := 'Соединиться';

end;

Фактически все управляется scMain, обработчиками OnAfterConnect (регистрирующим callback-интерфейс) и OnAfterDisconnect (производящим обратное действие). Разумеется, библиотека типов сервера подключена к проекту, но не через Import Type Library. Дело в том, что в проекте присутствует ActiveX Object TBackCall, который реализует интерфейс IBackCall, описанный в библиотеке типов сервера. Сделать такой объект очень просто: надо просто выбрать New -> Automation Object и в диалоге ввести имя BackCall (можно и другое, это не принципиально), выбрать ckSingle, и нажать ОК. В получившейся библиотеке типов сразу удалить интерфейс IBackCall, и на вкладке uses библиотеки типов подключить библиотеку типов сервера (есть локальное меню). После этого на вкладке Implements кокласса выбрать из списка интерфейс IBackCall. После обновления в модуле будет создан заглушка для метода OnCall, а в каталоге проекта клиента организуется файл импорта библиотеки типов сервера BkServer_TLB.pas, который остается только подключить к проекту и прописать в секциях uses модулей главной формы и СОМ-объекта. Метод OnCall я реализовал простейшим образом:

procedure TBackCall.OnCall(const MsgStr: WideString);

begin

 ShowMessage(MsgStr);

end;

После компиляции приложение можно запустить в двух-трех экземплярах и проверить его работоспособность. Необходимо учитывать, что сообщения получают все клиенты, кроме пославшего его.

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

Хотя мои друзья обозвали этот способ маршалинга вызовов "хакерским", мне все равно хотелось бы выразить им глубокую признательность за советы и терпение, с каким они отвечали на мои вопросы ;-)).

ПРИМЕЧАНИЕ

Исполняемые модули были созданы в Delphi5 SP1. Для работы приложения, естественно, необходимо запустить Borland Socket Server, который входит в поставку Delphi.