IdTCPServerExecute запускается, но не получает данные

Я очень новичок в delphi, и у меня есть два проекта, написанные на delphi, которые должны взаимодействовать - клиент и сервер. Мне удалось установить связь для подключения и отключения, но я не могу заставить клиента отправлять сообщения на сервер одним нажатием кнопки - похоже, что сообщения не доходят до сервера.

вот клиентский код:

unit my_client;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdTCPConnection,
  IdTCPClient, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
  IdBaseComponent, IdComponent;

type
  TForm1 = class(TForm)
    lstLog: TListBox;
    Label1: TLabel;
    txtData: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    txtServer: TEdit;
    txtPort: TEdit;
    btnConnect: TButton;
    btnSend: TButton;
    btnDisconnect: TButton;
    IdAntiFreeze1: TIdAntiFreeze;
    Client: TIdTCPClient;
    procedure btnConnectClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
  private
    ip: string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnConnectClick(Sender: TObject);
begin
    Client.Host := txtServer.Text;
    Client.Port := StrToInt(txtPort.Text);
    ip := txtServer.Text + ':' + txtPort.Text;
    lstLog.Items.Add('attempting to connect to ip [' + ip + ']');
    with Client do
    begin
        try //try connecting
          Connect;
          lstLog.Items.Add('successfully connected to ip [' + ip + ']');
          try //try getting data
            lstLog.Items.Add('response: [' + Client.IOHandler.ReadLn() + ']');
            BtnConnect.Enabled := False;
            BtnSend.Enabled := True;
            btnDisconnect.Enabled := True;
          except
            lstLog.Items.Add('cannot send data to ip [' + ip + ']');
            Client.Disconnect();
          end; //end try getting data
        except
          lstLog.Items.Add('cannot connect to ip [' + ip + ']');
        end; //end try connecting
    end; //end with
end; //end begin

procedure TForm1.btnSendClick(Sender: TObject);
begin
  lstLog.Items.Add('sending data: [' + txtData.Text + ']...');
  with Client do
  begin
    try
      IOHandler.Write(txtData.Text);
      lstLog.Items.Add('sent data: [' + txtData.Text + ']');
    except
      lstLog.Items.Add('failed to send data [' + ip + ']');
      Client.Disconnect();
      lstLog.Items.Add('Disconnect with ' + txtServer.Text + ' !');
      BtnConnect.Enabled := True;
      BtnSend.Enabled := False;
      btnDisconnect.Enabled := False;
    end;//end try
  end;//end with
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
  Client.Disconnect();
  lstLog.Items.Add('disconnected from ip [' + ip + ']');
  BtnConnect.Enabled := True;
  BtnSend.Enabled := False;
  btnDisconnect.Enabled := False;
end;

end.

и вот мой серверный код:

unit my_server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdTCPConnection, IdTCPClient, IdBaseComponent,
  IdComponent, IdCustomTCPServer, IdTCPServer, IdContext, IdThread, IdSync;

type
  TfrmTCPServer = class(TForm)
    edtPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    lbLog: TListBox;
    btnStart: TButton;
    btnStop: TButton;
    IdTCPServer: TIdTCPServer;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure IdTCPServerConnect(AContext: TIdContext);
    procedure IdTCPServerExecute(AContext: TIdContext);
    procedure IdTCPServerDisconnect(AContext: TIdContext);
    procedure IdTCPServerException(AContext: TIdContext;
      AException: Exception);
  private
  { Private declarations }
  public
  end;
var
  frmTCPServer: TfrmTCPServer;

implementation

uses
  StrUtils;

{$R *.dfm}

procedure TfrmTCPServer.btnStartClick(Sender: TObject);
begin
  IdTCPServer.DefaultPort := StrToInt(EdtPort.Text);
  IdTCPServer.Active := True;
  BtnStart.Enabled := False; //don't let it be clicked again
  BtnStop.Enabled := True; //let it be clicked again
  lbLog.Items.Add('server started');
end;

procedure TfrmTCPServer.btnStopClick(Sender: TObject);
begin
  if IdTCPServer.Active = true then
  begin
    IdTCPServer.Active := False;
    BtnStart.Enabled := True; //let it be clicked now
    BtnStop.Enabled := False; //don't let it be clicked again
    lbLog.Items.Add('server stopped');
  end
  else
  begin
    lbLog.Items.Add('server already stopped');
  end
end;

procedure TfrmTCPServer.IdTCPServerConnect(AContext: TIdContext);
begin
  try
    AContext.Connection.IOHandler.WriteLn('100: welcome to tcp test server');
    lbLog.Items.Add('server received connection from [' + Acontext.Connection.Socket.Binding.PeerIP + ']');
  except
    lbLog.Items.Add('got here2');
  end;
end;

procedure TfrmTCPServer.IdTCPServerExecute(AContext: TIdContext); //this is looped infinitely?
var
  client_data: string; //strCommand
begin
  with AContext.Connection do
  begin
    IOHandler.CheckForDataOnSource(10);
    if not IOHandler.InputBufferIsEmpty then
    begin
      client_data := IOHandler.ReadLn();
      IOHandler.WriteLn('received data [' + client_data + ']');
      lbLog.Items.Add('received data [' + client_data + '] from ' + Socket.Binding.PeerIP);
    end; //end if
  end; //end with
end;

procedure TfrmTCPServer.IdTCPServerDisconnect(AContext: TIdContext);
begin
  lbLog.Items.Add('client at ip [' + Acontext.Connection.Socket.Binding.PeerIP + '] has disconnected');
end;

procedure TfrmTCPServer.IdTCPServerException(AContext: TIdContext;
  AException: Exception);
begin
  lbLog.Items.Add('server exception: [' + AException.Message + ']');
end;

end.

проблема, похоже, кроется в процедуре IdTCPServerExecute на сервере. возможно, я использую его неправильно, или, может быть, мне нужно настроить некоторые параметры перед использованием этой процедуры?


person mulllhausen    schedule 16.05.2013    source источник
comment
Какой порт вы открываете? Вы знаете, что это не брандмауэр?   -  person J...    schedule 16.05.2013
comment
Брандмауэр блокирует соединения, а не данные. OP сказал, что соединение успешно. Так что это не проблема брандмауэра.   -  person Remy Lebeau    schedule 16.05.2013
comment
@RemyLebeau да, конечно, ты прав; Ницца.   -  person J...    schedule 17.05.2013


Ответы (1)


Код вашего сервера вызывает IOHandler.ReadLn(), который ожидает (CR) LF после текста. Ваш клиент звонит IOHandler.Write(), который не отправляет (CR) LF. Вместо этого клиенту необходимо вызвать IOHandler.WriteLn().

person Remy Lebeau    schedule 16.05.2013
comment
отлично. я использовал sLineBreak согласно этим вопросам и ответам - person mulllhausen; 17.05.2013
comment
sLineBreak зависит от платформы. Это CRLF в Windows, но LF на других платформах. Вам действительно не следует использовать его для связи. Просто используйте вместо этого WriteLn(), как я сказал: `IOHandler.WriteLn (txtData.Text) . It always sends a CRLF. If you insist on using Write () _ 4_EOL`, который является CRLF на всех платформах: IOHandler.Write(txtData.Text+EOL) - person Remy Lebeau; 17.05.2013
comment
ах, я должен был прочитать твой ответ более внимательно, я пропустил это. еще раз спасибо. - person mulllhausen; 17.05.2013
comment
Я устал запускать этот проект, сервер запускается нормально на порту 801, но когда кнопка подключения клиента нажимается, появляется это сообщение: attempting to connect to ip [127.0.0.1:801] и через 2 секунды cannot connect to ip [127.0.0.1:801], что может вызвать это? - person peiman F.; 14.03.2014
comment
Сервер работает на той же машине, что и клиент? Подтвердили ли вы с помощью netstat или другого инструмента, что сервер действительно прослушивает 127.0.0.1:801? - person Remy Lebeau; 14.03.2014
comment
да, оба находятся на одной машине, но на 801 порте нет слушателя !! как починить сервер ?! я загрузил сюда свой клиентский и серверный код: http://nilzoom.com/codes/p2p.rar - person peiman F.; 15.03.2014
comment
@peimanF .: Дважды проверьте свойство Port каждой записи в коллекции Bindings сервера. Вы устанавливаете DefaultPort сервера динамически, но если Bindings не пусто, то изменение DefaultPort не обновляет Port существующих Bindings записей. Вы должны либо обновить их по отдельности, либо Clear Bindings, чтобы сервер мог воссоздать их при активации. При активации сервера вы должны пройти Bindings регистрацию каждого IP / порта, который фактически используется. - person Remy Lebeau; 15.03.2014
comment
@peimanF .: Кроме того, в обработчиках событий вашего сервера прямой вызов lbLog.Items.Add() небезопасен для потоков. Для безопасного доступа к пользовательскому интерфейсу вам необходимо выполнить синхронизацию с основным потоком, например через TThread.Synchronize(), TThread.Queue(), TIdSync или TIdNotify, в противном случае могут произойти неприятности, включая взаимоблокировки и сбои. Кроме того, в обработчике OnExecute избавьтесь от CheckForDataOnSource() и InputBufferIsEmpty(). Вызовите ReadLn() безоговорочно и позвольте ему заблокироваться до тех пор, пока не будут получены данные или не произойдет отключение. - person Remy Lebeau; 15.03.2014
comment
спасибо, Реми, я добавил сюда новый вопрос: https://stackoverflow.com/questions/22422694/delphi-idtcpserver-not-listening - person peiman F.; 15.03.2014