私はデルファイに非常に慣れていません.デルファイで書かれた2つのプロジェクトがあり、通信する必要があります.クライアントとサーバーです。接続と切断のために通信を行うことができましたが、ボタンをクリックするだけでクライアントからサーバーにメッセージを送信させることができません。メッセージがサーバーに届かないようです。
クライアントコードは次のとおりです。
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 プロシージャにあるようです。正しく使用していない可能性があります。または、この手順を使用する前にいくつかのパラメーターを設定する必要がありますか?