Обмен информацией по TCP/IP-протоколу

Часто возникает необходимость обмениваться данными между программами на разных компьютерах. Например, это необходимо в чатах, или в программах, которые должны реагировать одновременно на одно и то же событие.
Обмен информации между компьютерами можно реализовать большим количеством способов. В данной статье я рассмотрю обмен данными по протоколу 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); // and there it goes...
 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;
 // AThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), true); // and there it goes...
 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;
 // AThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), true); // and there it goes...
 end
 // Различные сообщения
 else if (CommBlock.Command = {'MESSAGE'}cmMess) or (CommBlock.Command = 'DIALOG') then
 begin // 'MESSAGE': A message was send - forward or broadcast it
 // 'DIALOG': A dialog-window shall popup on the recipient's screen
 // it's the same code for both commands...
 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); // send the stuff
 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 // we don't have a login function so we have to use the DNS (Hostname)
 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'; // the message should popup on the client's screen
 NewCommBlock.MyUserName := '[Server]'; // the server's username
 NewCommBlock.Msg := 'I dont understand your command: "' + CommBlock.Command + '"'; // the message to show
 NewCommBlock.ReceiverName := '[return-to-sender]'; // unnecessary
 AThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), true); // and there it goes...
 end;
 end;
end;
Здесь я реализовал дополнительную регистрацию компьютера с помощью команды cmRegisterComp='REGISTER', и дополнительно посылку сообщения, что компьютер отключился: cmUnRegisterComp='UNREGISTER'.
При передаче сообщения передаётся сообщения типа TCommBlock. Это тип данных мы можем изменять по необходимости. В данном блоке я объявил переменную для идентификации ComputerName компьютера.
TCommBlock = record // the Communication Block used in both parts (Server+Client)
 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 .
* Установим на форму кнопки Подключиться и Отключиться.
Обработчик кнопки Подключиться:
try
 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 предназначен для обработки команд с клиентской стороны.
type
 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)
implementation
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;
 Copyright© 2004 Рудюк С.А.
Author: Рудюк С.А.
Source: rudjuk.kiev.ua
ID: 03361
Category:Связь
Category:Статьи
Category:Учебники