IdTCPServerExecute运行但不接收数据

时间:2013-05-16 09:23:19

标签: delphi indy

我是delphi的新手,我有两个用delphi编写的项目,它们必须通信 - 客户端和服务器。我设法让comms进行连接和断开连接,但是我无法让客户端通过单击按钮将消息发送到服务器 - 看起来这些消息没有进入服务器。

这是客户端代码:

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过程。也许我没有正确使用它,或者我可能需要在使用此程序之前设置一些参数?

1 个答案:

答案 0 :(得分:4)

您的服务器代码正在调用IOHandler.ReadLn(),它需要文本后面的(CR)LF。您的客户正在呼叫IOHandler.Write(),它不会发送(CR)LF。客户需要拨打IOHandler.WriteLn()