Часто возникает необходимость обмениваться данными между программами на разных компьютерах. Например, это необходимо в чатах, или в программах, которые должны реагировать одновременно на одно и то же событие. Обмен информации между компьютерами можно реализовать большим количеством способов. В данной статье я рассмотрю обмен данными по протоколу TCP/IP. Компоненты для обмена данными по TCP/IP Для обмена данными по протоколу TCP/IP будем использовать три Indy-компоненты: TIdTCPServer , TIdTCPClient , TIdThreadMgrDefault. Клиентская компонента предназначена для посылки и приёма сообщений, а серверная компонента - для приёма сообщения и рассылки клиентским компонентам. Программная реализация Программа состоит из двех частей: серверная, на которой стоит серверная компонента, можно на неё ещё поставить и клиентскую компоненту - для тестирования клиентской части и возможности генерации сообщений с серверной программы. На клиентской части - стоит только клиентская компонента. Эта часть предназначена только для посылки и приёма сообщений. Серверная часть Установим на форму в программе серверной части компоненты TIdTCPServer , TIdThreadMgrDefault . Свяжите свойство ThreadMgr компоненты TIdTCPServer с компонентой TIdThreadMgrDefault. Для запуска сервера хватит установить свойство компоненты в True: Server.Active := True; Protocol.Lines.Add('=== Запуск сервера ===='); Для остановки сервера - в False: Server.Active := False; Protocol.Lines.Add('=== Сервер остановлен===='); Для регистрации подключенного компьютера следует определить событие OnConnect в компоненте TIdTCPServer. var NewClient: PClient; begin GetMem(NewClient, SizeOf(TClient)); NewClient.DNS := AThread.Connection.LocalName; NewClient.Connected := Now; NewClient.LastAction := NewClient.Connected; NewClient.Thread := AThread; AThread.Data:=TObject(NewClient); try Clients.LockList.Add(NewClient); finally Clients.UnlockList; end; Protocol.Lines.Add(TimeToStr(Time)+' Соединение компьютера: "'+NewClient.DNS+'"'); end; Для регистрации отключения клиента необходимо определить событие ServerDisconnect. var ActClient: PClient; ConnN: integer; begin ActClient := PClient(AThread.Data); Protocol.Lines.Add(TimeToStr(Time)+'Отсоединение компа: "'+ActClient^.DNS+'"'); try Clients.LockList.Remove(ActClient); finally Clients.UnlockList; end; FreeMem(ActClient); AThread.Data := nil; end; Обработка команд (рассылка) на серверной части осуществляется с помощью события OnExecute. var ActClient, RecClient: PClient; CommBlock, NewCommBlock: TCommBlock; RecThread: TIdPeerThread; i, ConnN: Integer; itmp: integer; begin if not AThread.Terminated and AThread.Connection.Connected then begin AThread.Connection.ReadBuffer (CommBlock, SizeOf (CommBlock)); ActClient := PClient(AThread.Data); ActClient.LastAction := Now; // update the time of last action // Регистрация компьютера if (RusUpperCase(CommBlock.Command) = RusUpperCase(cmRegisterComp)) then begin Protocol.Lines.Add(' Регистрация компьютера: '+ RusUpperCase(CommBlock.ComputerName)); meConnected.Lines.Add(RusUpperCase(CommBlock.ComputerName)); RefreshConnected; RefreshConnectedComps; RefreshGolosProcess; // AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true); end // Удаление компьютера else if (RusUpperCase(CommBlock.Command) = RusUpperCase(cmUnRegisterComp)) then begin Protocol.Lines.Add(' Удаление компьютера: '+RusUpperCase(CommBlock.ComputerName)); ConnN:=FindConnComp(RusUpperCase(CommBlock.ComputerName)); if ConnN<>-1 then meConnected.Lines.Delete(ConnN); RefreshConnected; RefreshConnectedComps; RefreshGolosProcess; end // Регистрация ответов else if (RusUpperCase(CommBlock.Command) = RusUpperCase(cmAnswerQuest)) then begin if mdGolos.Locate('CompName',RusUpperCase(CommBlock.Msg),[loCaseInsensitive]) then begin mdGolos.Edit; mdGolosCONN.Value:=True; mdGolos.Post; end; RefreshGolosProcess; end // Различные сообщения else if (CommBlock.Command = {'MESSAGE'}cmMess) or (CommBlock.Command = 'DIALOG') then begin if CommBlock.ReceiverName = '' then begin // no recipient given - broadcast Protocol.Lines.Add (TimeToStr(Time)+' Получение сообщения от ' +CommBlock.MyUserName+' '+CommBlock.Command+': "'+CommBlock.Msg+'"'); NewCommBlock := CommBlock; // nothing to change ;-)) with Clients.LockList do try for i := 0 to Count-1 do // iterate through client-list begin RecClient := Items[i]; // get client-object RecThread := RecClient.Thread; // get client-thread out of it RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); end; finally Clients.UnlockList; end; end else begin // receiver given - search him and send it to him NewCommBlock := CommBlock; // again: nothing to change ;-)) Protocol.Lines.Add(TimeToStr(Time)+' Посылка '+CommBlock.Command+ ' к "'+CommBlock.ReceiverName+'": "'+CommBlock.Msg+'"'); with Clients.LockList do try for i := 0 to Count-1 do begin RecClient:=Items[i]; if RecClient.DNS=CommBlock.ReceiverName then begin RecThread:=RecClient.Thread; RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); end; end; finally Clients.UnlockList; end; end; end else begin // unknown command given Protocol.Lines.Add (TimeToStr(Time)+' Unknown command from "'+ CommBlock.MyUserName+'": '+CommBlock.Command); NewCommBlock.Command := 'DIALOG'; NewCommBlock.MyUserName := '[Server]'; NewCommBlock.Msg := 'I don''t understand your command: "'+CommBlock.Command+'"'; NewCommBlock.ReceiverName := '[return-to-sender]'; AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true); end; end; end; Здесь я реализовал дополнительную регистрацию компьютера с помощью команды cmRegisterComp='REGISTER', и дополнительно посылку сообщения, что компьютер отключился: cmUnRegisterComp='UNREGISTER'. При передаче сообщения передаётся сообщения типа TCommBlock. Это тип данных мы можем изменять по необходимости. В данном блоке я объявил переменную для идентификации ComputerName компьютера. // the Communication Block used in both parts (Server+Client) TCommBlock = record Command, MyUserName, // the sender of the message Msg, // the message itself ReceiverName: string[100]; // name of receiver ComputerName: String[100]; // Название компьютера, посылающего сообщение end; Command - команда, которая посылается с клиентского места. MyUserName - имя пользователя, который посылает сообщение. Msg - Текст сообщения. ReceiverName - название компьютера-получателя сообщения, если это поле будет пустым, то сообщение будет отправляться всем компьютерам. Клиентская часть Через клиентскую компоненту мы можем отправлять сообщения, а так же получать сообщения от других сообщений. Установим на форму клиентского приложения компоненту TIdTCPClient . Установим на форму кнопки Подключиться и Отключиться. Обработчик кнопки Подключиться: IncomingMessages.Lines.Add('===Подключение к серверу==='); Client.Host:=DBInfo.IBaseServerName; Client.Connect(10000); // in Indy < 8.1 leave the parameter away ClientHandleThread := TClientHandleThread.Create(True); ClientHandleThread.Cli:=Client; ClientHandleThread.EventMest:=FEventMess; ClientHandleThread.Str:=IncomingMessages.Lines; ClientHandleThread.FreeOnTerminate:=True; ClientHandleThread.Resume; RegComp; except on E: Exception do MessageDlg ('Ошибка подключения:'+#13+E.Message, mtError, [mbOk], 0); end; В кнопке Отключиться прописываем: if Client.Connected then begin ClientHandleThread.Terminate; Client.Disconnect; end; Тип TClientHandleThread предназначен для обработки команд с клиентской стороны. TEvent_Mesto = procedure(Sender: TObject) of object; .... TClientHandleThread = class(TThread) private procedure HandleInput; public Str: TStrings; Cli: TIdTCPClient; protected procedure Execute; override; public CB: TCommBlock; FEventMest: TEvent_Mesto; published property EventMest: TEvent_Mesto read FEventMest write FEventMest; end; .... var ClientHandleThread: TClientHandleThread; // variable (type see above) .... procedure TClientHandleThread.Execute; begin while not Terminated do begin if not Cli.Connected then Terminate else try Cli.ReadBuffer(CB, SizeOf (CB)); Synchronize(HandleInput); except end; end; end; .... procedure TClientHandleThread.HandleInput; begin if Assigned(EventMest) then EventMest(Self); // Обработка команд if RusCompare(CB.Command,'MESSAGE') Or (RusCompare(CB.Command,cmdSendPrav)) or (RusCompare(CB.Command, cmdAskPrav)) or (RusCompare(CB.Command,cmdNewGame)) or (RusCompare(CB.Command,cmdEndGame)) or (RusCompare(CB.Command,cmdNewTur)) or (RusCompare(CB.Command,cmdEndTur)) or (RusCompare(CB.Command,cmdRunShellAll)) or (RusCompare(CB.Command,cmdRunShell)) or (RusCompare(CB.Command,cmdSendActiveWinAll)) or (RusCompare(CB.Command,cmdSendActiveWin)) or (RusCompare(CB.Command,cmdMinimizeWin)) or (RusCompare(CB.Command,cmdMinimizeWinAll)) or (RusCompare(CB.Command,cmdCloseWin)) or (RusCompare(CB.Command,cmdCloseWinAll)) or (RusCompare(CB.Command,cmdSendUserName)) or (RusCompare(CB.Command,cmdSendPassword)) or (RusCompare(CB.Command,cmdNextGolos)) or (RusCompare(CB.Command,cmdGolosSended)) or (RusCompare(CB.Command,cmdGolosEkspert)) or (RusCompare(CB.Command,cmdRefreshInfo)) or (RusCompare(CB.Command,cmdRefreshInfoAll)) or (RusCompare(CB.Command,cmdSendMessage)) or (RusCompare(CB.Command,cmdSendMessageAll)) or (RusCompare(CB.Command,cmdSendMessageAdmin)) or (RusCompare(CB.Command,cmdClearMessages)) or (RusCompare(CB.Command,cmdClearMessgesAll)) or (RusCompare(CB.Command,cmdReconnected)) or (RusCompare(CB.Command,cmdReconnectedAll)) or (RusCompare(CB.Command,cmdSetOcenk)) or RusCompare(CB.Command, cmdRegComp) then Str.Add (CB.MyUserName + ': ' + CB.Msg) else if RusCompare(CB.Command,'DIALOG') then MessageDlg ('"'+CB.MyUserName+'" посылаем сообщение:'+ #13+CB.Msg, mtInformation, [mbOk], 0) else // unknown command MessageDlg('Команда "'+CB.Command+'" содержит это сообщение:'+ #13+CB.Msg, mtError, [mbOk], 0); end; ... В процедуре HandleInput перехватываются сообщения. В событии EventMest мы можем определить процедуру, которая будет выполняться при получении сообщения. Помещаем на форму кнопку Послать, поле ввода Сообщение, и список Команда, где будут перечислены все доступные команды. В обработчике щелчка кнопки опишем команду посылки сообщения: var CommBlock : TCommBlock; begin inherited; // Команда, которую мы посылаем CommBlock.Command := RusUpperCase(EditCommand.Text); // Название компьютера CommBlock.MyUserName := Client.LocalName; // Текст сообщения CommBlock.Msg := EditMessage.Text; // Название компьютера, которому мы посылаем сообщение CommBlock.ReceiverName := EditRecipient.Text; // Название компьютера, который посылает сообщение CommBlock.ComputerName := RusUpperCase(Client.LocalName); Client.WriteBuffer (CommBlock, SizeOf (CommBlock), true); end;
Источник: http://rudjuk.kiev.ua/ |