Обмен информацией по 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);
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; 

Статьи по теме

Команды Linux

В данной статье приведена краткая информация о командах Linux. Хочу заметить, что приведенные здесь команды не привязаны к определенному д...

2013-10-04

Технология создания форм для работы со справочниками

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

2013-10-04

Перечисление сетевых интерфейсов

Автор: Konstantin MalahovИсточник: www.varkon.bizВ процессе работы твоей программы нередко надо получить список сетевых адресов доступных на данном к...

2013-10-04

ASP.NET MVC: Knockout, JsSite - редактирование комплексных типов или DbLookUp на AJAX

А что в итоге?Для того, чтобы сразу же стало понятно, ради чего мы сегодня собрались в этом маленьком блоге, позвольте показать вам видеор...

2013-10-04

ASP.NET MVC: DataSource на JavaScript для работы с Web API или снова про JsSite

DataSource – контрол написанный на языке JavaScript. Библиотека JsSite включает в себя, на мой взгляд, полезный js-контрол, который может очень просто �...

2013-10-04

ASP.NET MVC: DataSource на JavaScript или обертка на Web API сервис (часть 1)

Подготовим проект1. Создаем новый проект по шаблону ASP.NET MVC 4 (я выбрал “basic”). На момент создания статьи ASP.NET MVC 5 находится в статусе beta. Из�...

2013-10-04

ASP.NET MVC: DataSource на JavaScript или обертка на Web API сервис (часть 2)

Что к чемуВ прошлой статье есть ссылка на проект, его мы и будем доводить до ума. В противном случае, вы можете скачать уже обновленный пр�...

2013-10-04

Knockout: Переключаем проверку ввода на русский язык или Knockout.Validation Localize (Globalize)

Если вы используете Knockoutjs, то наверное уже не раз приходилось делать проверку данных, которые вводит пользователь. А как вы проверяли вв�...

2013-04-30

ASP.NET MVC: UrlReferrer или куда послать пользователя

Задача на статьюПредыстория описана в описании статьи, а значит сразу к делу. Чтобы вернуть пользователя “обратно”. Надо знать откуда о...

2013-04-29

HTML 5: Пример использования knockout, amplify и underscore или JsSite как стартовая архитектура для сайта (обновление)

ЦельВ одной из прошлых статьей было рассказано о nuget-пакете под названием JsSite. В последнее время достаточно часто и продуктивно пришлось...

2013-02-22

JQuery слайдер

Автор: mike7 февраля 2013 года Последнее время большую популярность приобрели движущиеся горизонтальные панели, известные также как "Слай�...

2013-02-13

HTML5: PagedList на knockout.js или как разбить данные на страницы через AJAX

Постановка задачиТребуется получение данных в формате JSON. Данные должны быть разбиты на страницы, размер страниц можно устанавливать, с...

2013-02-13

ASP.NET MVC: Редактируем Html в CKEditor через Knockout

Введение Редактирование html-кода достаточно тривиальная задача. Если учесть, что количество WYSIWYG-редакторов в сети огромное колич...

2013-02-07

HTML 5: Пример использования knockout или JsSite как стартовая архитектура для сайта

ЗачемДля того чтобы начать приложение на HTML5 с использованием knockout мне обычно приходилось устанавливать некоторое количество nuget-пакет�...

2013-02-07

ASP.NET MVC: Просмотр и отладка JSON объектов при использвании Knockout

Снова KnockoutСамое тяжелое непривычное при работе с knockout, так это, на мой взгляд, отладка и просмотр данных (ViewModel), который привязывается к ф...

2013-01-17