参照网上做的indy简单TCP程序,为什么不行
本帖最后由 buynoo 于 2010-12-04 23:16:24 编辑 教程网址:http://www.bianceng.cn/Programming/Delphi/200711/5436_3.htm
接下来是代码 可能大家都做过 我也基本是复制粘贴的 就申明了几个过程/变量而已 居然还会出错
客户端:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient;
type
TFormMain = class(TForm)
IdTCPClient: TIdTCPClient;
IdAntiFreeze: TIdAntiFreeze;
EdtHost: TEdit;
EdtPort: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
EdtData: TEdit;
LbLog: TListBox;
BtnConnect: TButton;
BtnSend: TButton;
BtnDisconnect: TButton;
Label4: TLabel;
procedure BtnConnectClick(Sender: TObject);
procedure BtnSendClick(Sender: TObject);
procedure BtnDisconnectClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
implementation
{$R *.dfm}
//连接
procedure TFormMain.BtnConnectClick(Sender: TObject);
begin
IdTCPClient.Host := EdtHost.Text;
IdTCPClient.Port := StrToInt(EdtPort.Text);
LbLog.Items.Add('正在连接 ' + EdtHost.Text + '...');
with IdTCPClient do
begin
try
Connect(5000);
try
LbLog.Items.Add(ReadLn());
BtnConnect.Enabled := False;
BtnSend.Enabled := True;
BtnDisconnect.Enabled := True;
except
LbLog.Items.Add('远程主机无响应！');
IdTCPClient.Disconnect();
end;//end try
except
LbLog.Items.Add('无法建立到' + EdtHost.Text + '的连接！');
end;//end try
end;//end with
end;
//发送数据
procedure TFormMain.BtnSendClick(Sender: TObject);
begin
LbLog.Items.Add('DATA ' + EdtData.Text);
with IdTCPClient do
begin
try
WriteLn('DATA ' + EdtData.Text);
LbLog.Items.Add(ReadLn())
except
LbLog.Items.Add('发送数据失败！');
IdTCPClient.Disconnect();
LbLog.Items.Add('同主机 ' + EdtHost.Text + ' 的连接已断开！');
BtnConnect.Enabled := True;
BtnSend.Enabled := False;
BtnDisconnect.Enabled := False;
end;//end try
end;//end with
end;
//断开连接
procedure TFormMain.BtnDisconnectClick(Sender: TObject);
var
Received: string;
begin
LbLog.Items.Add('QUIT');
try
IdTCPClient.WriteLn('QUIT');
finally
IdTCPClient.Disconnect();
LbLog.Items.Add('同主机 ' + EdtHost.Text + ' 的连接已断开！');
BtnConnect.Enabled := True;
BtnSend.Enabled := False;
BtnDisconnect.Enabled := False;
end;//end try
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer, StrUtils;
type
TFormMain = class(TForm)
Label1: TLabel;
EdtPort: TEdit;
Label2: TLabel;
EdtData: TEdit;
Label3: TLabel;
LbLog: TListBox;
BtnStart: TButton;
BtnStop: TButton;
IdTCPServer: TIdTCPServer;
procedure BtnStartClick(Sender: TObject);
procedure BtnStopClick(Sender: TObject);
procedure IdTCPServerConnect(AThread: TIdPeerThread);
procedure IdTCPServerExecute(AThread: TIdPeerThread);
procedure DisplayData();
procedure AddLogEntry();
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
FLogEntry: string;
FReceived: string;
implementation
{$R *.dfm}
procedure TFormMain.BtnStartClick(Sender: TObject);
begin
IdTCPServer.DefaultPort := StrToInt(EdtPort.Text); //获取端口值
IdTCPServer.Active := True; //启用IdTCPServer
BtnStart.Enabled := False;
BtnStop.Enabled := True;
LbLog.Items.Add('服务器已成功启动！');
end;
procedure TFormMain.BtnStopClick(Sender: TObject);
begin
IdTCPServer.Active := False; //不启用
BtnStart.Enabled := True;
BtnStop.Enabled := False;
LbLog.Items.Add('服务器已成功停止！');
end;
procedure TFormMain.IdTCPServerConnect(AThread: TIdPeerThread); //被连接
begin
LbLog.Items.Add('来自主机 '
+ AThread.Connection.Socket.Binding.PeerIP
+ ' 的连接请求已被接纳！');
AThread.Connection.WriteLn('100: 欢迎连接到TCP服务器！');
end;
procedure TFormMain.IdTCPServerExecute(AThread: TIdPeerThread);
var
sCommand: string;
begin
with AThread.Connection do
begin
sCommand := ReadLn();
FLogEntry := sCommand + ' 来自于主机 '
+ AThread.Connection.Socket.Binding.PeerIP;
AThread.Synchronize(AddLogEntry);
if AnsiStartsText('DATA ', sCommand) then
begin
FReceived := RightStr(sCommand, Length(sCommand)-5);
WriteLn('200: 数据接收成功！');
AThread.Synchronize(DisplayData);
end
else if SameText(sCommand, 'QUIT') then begin
FLogEntry := '断开同主机 '
+ AThread.Connection.Socket.Binding.PeerIP
+ ' 的连接！';
AThread.Synchronize(AddLogEntry);
Disconnect;
end
else begin
WriteLn('500: 无法识别的命令！');
FLogEntry := '无法识别命令：' + sCommand;
AThread.Synchronize(AddLogEntry);
end;//endif
end;
end;
procedure TFormMain.DisplayData();
begin
EdtData.Text := FReceived;
end;
procedure TFormMain.AddLogEntry();
begin
LbLog.Items.Add(FLogEntry);
end;
end.
try
LbLog.Items.Add(ReadLn());
BtnConnect.Enabled := False;
BtnSend.Enabled := True;
BtnDisconnect.Enabled := True;
except
LbLog.Items.Add('远程主机无响应！');
IdTCPClient.Disconnect();
end;
