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