Обратные вызовы в MIDAS через TSocketConnection (стр. 2 из 2)

Если бы модель потоков была 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) thenbegin //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) dobegin 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.