TCP对话框

 

 有一个TCP的小问题还没有解决，就是在“TCPClient”在连接状态下，关闭“TCPServer”会报错。网上查了一下，有一个很好的解决办法是，在关闭服务端之前，先给客户端发送断开消息，客户端收到指定的断开消息之后，主动断开连接。这样关闭“TCPClient”就什么问题了。

 

控件都是图上有的那几个，直接放源码了，

环境：window10专业版、delphi 10.2 (Tokyo)、Indy10

 

unit UnitServer;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
IdComponent, IdTCPServer, IdContext, IPPeerServer, FMX.Objects, System.Math,
Datasnap.DSCommonServer, Datasnap.DSTCPServerTransport,IdGlobal, Vcl.ComCtrls, IdTCPConnection,
IdCustomTCPServer, IdSocketHandle, StrUtils, Vcl.Imaging.jpeg,
System.ImageList, Vcl.ExtCtrls;

type
TFormServer = class(TForm)
edtPort: TEdit;
lbl1: TLabel;
TMemoLog: TMemo;
btnSend: TButton;
TMemoSend: TMemo;
btnStart: TButton;
btnClose: TButton;
idtcpsrvr1: TIdTCPServer;
procedure btnStartClick(Sender: TObject);
procedure idtcpsrvr1Connect(AContext: TIdContext);
procedure btnSendClick(Sender: TObject);
procedure idtcpsrvr1Execute(AContext: TIdContext);
procedure idtcpsrvr1Disconnect(AContext: TIdContext);
procedure edtPortKeyPress(Sender: TObject; var Key: Char);
procedure TMemoSendKeyPress(Sender: TObject; var Key: Char);
procedure btnCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormServer : TFormServer;

implementation

{$R *.dfm}
{$R TCPServer.res}

procedure TFormServer.btnCloseClick(Sender: TObject);
var
i : Integer;
LContext :TIdContext;
TCPClientList : TList;
begin

try
TCPClientList := idtcpsrvr1.Contexts.LockList;
try

for i := 0 to TCPClientList.Count - 1 do begin
//先发送消息，让TCPClient关闭连接，然后在关闭TCPServer就不会报错了
TIdContext(TCPClientList.Items[I]).Connection.IOHandler.WriteLn('断开');
TIdContext(TCPClientList.Items[I]).Connection.Disconnect;
end;

finally
idtcpsrvr1.Contexts.UnlockList;
end;
idtcpsrvr1.Active := False;

TMemoLog.Lines.Add('******************************');
TMemoLog.Lines.Add('TCPServer服务已经关闭！');
except
on E:Exception do begin
TMemoLog.Lines.Add('关闭TCPServer失败！' + E.ClassName + ',' + E.Message );
end;
end;
end;

procedure TFormServer.btnSendClick(Sender: TObject);
var
I :Integer;
LContext :TIdContext;
TCPClientList : TList;
begin
TCPClientList := idtcpsrvr1.Contexts.LockList;
try
for i := 0 to TCPClientList.Count - 1 do begin

LContext := TCPClientList[i];
LContext.Connection.IOHandler.WriteLn(TMemoSend.Text);
TMemoLog.Lines.Add(DateTimeToStr(Now));
TMemoLog.Lines.Add('S: '+TMemoSend.Text);

end;
finally
idtcpsrvr1.Contexts.UnlockList;
end;
TMemoSend.Clear;
end;

procedure TFormServer.btnStartClick(Sender: TObject);
var
steyint :string;
begin
try
steyint := edtPort.Text;
idtcpsrvr1.DefaultPort := steyint.ToInteger;
idtcpsrvr1.Active := True;
TMemoLog.Lines.Add('******************************');
TMemoLog.Lines.Add('TCPServer服务启动成功！');
except
// TMemoLog.Lines.Add('******************************');
// TMemoLog.Lines.Add('TCPServer服务启动失败！');

on E:Exception do begin
TMemoLog.Lines.Add('TCPServer服务启动失败!' + E.ClassName + ',' + E.Message );
end;
end;
end;

procedure TFormServer.edtPortKeyPress(Sender: TObject; var Key: Char);
begin
if not(key in['0'..'9',#8])then begin //只能输入数字，和退格键
key := #0;
end;
end;

procedure TFormServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
idtcpsrvr1.Active := False;
end;

procedure TFormServer.idtcpsrvr1Connect(AContext: TIdContext);
begin

TMemoLog.Lines.Add('******************************');
TMemoLog.Lines.Add('有客户端TCPClient连接成功！' + 'IP:' + AContext.Connection.Socket.Host );
TMemoLog.Lines.Add('******************************');

//设置中文不乱码
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8(); //中文处理

end;

procedure TFormServer.idtcpsrvr1Disconnect(AContext: TIdContext);
begin
if (csDestroying in Self.ComponentState) <> True then begin
TMemoLog.Lines.Add('******************************');
TMemoLog.Lines.Add('有客户端TCPClient断开连接！' +'IP:'+AContext.Connection.IOHandler.Host);
TMemoLog.Lines.Add('******************************');

end;

end;

procedure TFormServer.idtcpsrvr1Execute(AContext: TIdContext);
var
strCmd : string;
begin
strCmd := AContext.Connection.IOHandler.ReadLn;
TMemoLog.Lines.Add(DateTimeToStr(Now));
TMemoLog.Lines.Add('C: '+AContext.Connection.IOHandler.Port.ToString+':'+strCmd);

end;

procedure TFormServer.TMemoSendKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then begin //回车键触发发送
FormServer.btnSend.OnClick(nil);
Key := #0;
end;
end;

end.

 

 

************************************************************************分割线********************************************************************************

 

 

 

unit UnitClient;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent, Vcl.Imaging.jpeg,
IdComponent, IdTCPConnection, IdTCPClient, IdContext,IdGlobal,System.Math, FMX.Objects,
Vcl.ExtCtrls;
type
TFormClient = class(TForm)
edtAddress: TEdit;
edtPort: TEdit;
lbl1: TLabel;
lbl2: TLabel;
TMemoSend: TMemo;
TMemoLog: TMemo;
btnClient: TButton;
btnSend: TButton;
btnNoClient: TButton;
idtcpclnt1: TIdTCPClient;
procedure btnClientClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure edtPortKeyPress(Sender: TObject; var Key: Char);
procedure TMemoLogKeyPress(Sender: TObject; var Key: Char);
procedure edtAddressKeyPress(Sender: TObject; var Key: Char);
procedure btnNoClientClick(Sender: TObject);
procedure idtcpclnt1Connected(Sender: TObject);
procedure idtcpclnt1Disconnected(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormClient: TFormClient;

implementation

{$R *.dfm}
{$R TCPClient.res}

procedure TFormClient.btnClientClick(Sender: TObject);
begin
idtcpclnt1.Host := Trim(edtAddress.Text);
idtcpclnt1.Port := StrToIntDef(Trim(edtPort.Text),9999);
try
idtcpclnt1.Connect;
except
TMemoLog.Lines.Add('TCPClient连接服务端'+edtAddress.Text+'失败！')
end;
end;

procedure TFormClient.btnNoClientClick(Sender: TObject);
begin
try
idtcpclnt1.Disconnect;
except
on E:Exception do begin
TMemoLog.Lines.Add(E.ClassName + ',' + E.Message);
TMemoLog.Lines.Add('连接断开异常..');
Exit;
end;
end;
end;

procedure TFormClient.btnSendClick(Sender: TObject);
var
stgf : string;
begin

try
try
// WriteLn('SendString'); //通知服务器
idtcpclnt1.IOHandler.WriteLn(TmemoSend.Text);

TMemoLog.Lines.Add(DateTimeToStr(Now));
TMemoLog.Lines.Add('C:' + TmemoSend.Text);

// stgf := msdtcpclnt1.IOHandler.ReadLn;
// mmoFrom.Lines.Add('S:'+ DateTimeToStr(Now));
// mmoFrom.Lines.Add('S:'+ stgf);
except
on E:Exception do begin
TMemoLog.Lines.Add(TimeToStr(Now) + E.ClassName + ',' + E.Message);
Exit;
end;
end;
finally
TmemoSend.Clear;
end;

end;

procedure TFormClient.edtAddressKeyPress(Sender: TObject; var Key: Char);
begin
if not(key in['0'..'9',#8])then begin //只能输入数字，和退格键
key := #0;
end;
end;

procedure TFormClient.edtPortKeyPress(Sender: TObject; var Key: Char);
begin
if not(key in['0'..'9',#8])then begin //只能输入数字，和退格键
key := #0;
end;
end;

procedure TFormClient.idtcpclnt1Connected(Sender: TObject);
begin
TMemoLog.Lines.Add('******************************');
TMemoLog.Lines.Add('TCPClient连接服务端'+edtAddress.Text+'成功！');
TMemoLog.Lines.Add('******************************');
//设置中文不乱码
idtcpclnt1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8(); //中文处理
end;

procedure TFormClient.idtcpclnt1Disconnected(Sender: TObject);
begin
TMemoLog.Lines.Add('******************************');
TMemoLog.Lines.Add('TCPClient已经断开与服务'+edtAddress.Text+'的，连接！');
TMemoLog.Lines.Add('******************************');
end;

procedure TFormClient.TMemoLogKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then begin //回车键触发发送
FormClient.btnSend.OnClick(nil);
key := #0;
end;
end;

end.