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

Материал из DRKB


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

Обмен информации между компьютерами можно реализовать большим количеством способов. В данной статье я рассмотрю обмен данными по протоколу TCP/IP.


Компоненты для обмена данными по TCP/IP[править | править код]

Для обмена данными по протоколу TCP/IP будем использовать три Indy-компоненты:

TIdTCPServer Idtcpserv icon.png
TIdTCPClient Idtcpclient icon.png
TIdThreadMgrDefault TIdThreadMgrDefault icon.png

Клиентская компонента предназначена для посылки и приёма сообщений, а серверная компонента - для приёма сообщения и рассылки клиентским компонентам.

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


Серверная часть[править | править код]

Установим на форму в программе серверной части компоненты TIdTCPServer Idtcpserv icon.png, TIdThreadMgrDefault TIdThreadMgrDefault icon.png.

Свяжите свойство 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 Idtcpclient icon.png.
  • Установим на форму кнопки Подключиться и Отключиться.

Обработчик кнопки Подключиться:

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