delphi-10.2-tokyo - 安全关闭来自 IdTCPServer 中服务器的所有连接
问题描述
我正在尝试在连接客户端时停用 TIdTCPServer。我的程序停止响应。有人可以帮忙吗?这是我的示例代码。在服务器端,我打开一个端口并等待客户端在 5 秒内发送文本行。收到后,我将其发送回客户端并等待另一行。
unit port_test;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdTCPServer, Vcl.StdCtrls, IdContext;
type
TForm1 = class(TForm)
Memo1: TMemo;
IdTCPServer1: TIdTCPServer;
IdTCPServer2: TIdTCPServer;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer2Connect(AContext: TIdContext);
procedure IdTCPServer2Disconnect(AContext: TIdContext);
procedure IdTCPServer1Disconnect(AContext: TIdContext);
procedure FormCreate(Sender: TObject);
procedure IdTCPServer1Execute(AContext: TIdContext);
procedure IdTCPServer2Execute(AContext: TIdContext);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);//active or deactive socket1
var
i: integer;
begin
if IdTCPServer1.Active then
begin
IdTCPServer1.StopListening;
if IdTCPServer1.Contexts <>nil then
begin
with IdTCPServer1.Contexts.LockList do
try
i := 0;
while i < Count do
begin
TIdContext(Items[i]).Connection.Disconnect;
inc(i);
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
IdTCPServer1.Active:= false;
Button1.Caption:= 'Listening';
end
else
begin
IdTCPServer1.DefaultPort:= strtoint(edit1.Text);
IdTCPServer1.Active:= true;
Button1.Caption:= 'Release';
end;
end;
procedure TForm1.Button2Click(Sender: TObject);////active or deactive socket1
begin
if IdTCPServer2.Active then
begin
IdTCPServer2.Active:= false;
Button2.Caption:= 'Listening';
end
else
begin
IdTCPServer2.DefaultPort:= strtoint(edit2.Text);
IdTCPServer2.Active:= true;
Button2.Caption:= 'Release';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Clear;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
memo1.Lines.Add(AContext.Binding.IP + ' On Port: '+ inttostr(AContext.Binding.port)+ ' Connected');
memo1.Lines.Add('Peer Ip: '+ AContext.Binding.PeerIP +' On Peer Port: '+ inttostr(AContext.Binding.PeerPort)
+' Port: ' + inttostr(AContext.Binding.Port));
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
memo1.Lines.Add(AContext.Binding.IP + ' On Port: '+ inttostr(AContext.Binding.port)+ ' DisConnected');
memo1.Lines.Add('Peer Ip: '+ AContext.Binding.PeerIP +' On Peer Port: '+ inttostr(AContext.Binding.PeerPort)
+' Port: ' + inttostr(AContext.Binding.Port));
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
str_tmp: string;
begin
memo1.Lines.Add('Socket1 Listening___ for 5s');
try
AContext.Connection.IOHandler.ReadTimeout:= 5000;
str_tmp:= AContext.Connection.IOHandler.ReadLn();
if AContext.Connection.IOHandler.ReadLnTimedout then
memo1.Lines.Add('Socket1 Timeout.')
else
begin
memo1.Lines.Add('S1<<'+ str_tmp);
AContext.Connection.IOHandler.WriteLn(str_tmp + '!Send Back!');
memo1.Lines.Add('S1>>'+ str_tmp + '!Send Back!' );
end;
Except
memo1.Lines.Add('Socket1 Err');
end;
end;
procedure TForm1.IdTCPServer2Connect(AContext: TIdContext);
begin
memo1.Lines.Add(AContext.Binding.IP + ' On Port: '+ inttostr(AContext.Binding.port)+ ' Connected');
memo1.Lines.Add('Peer Ip: '+ AContext.Binding.PeerIP +' On Peer Port: '+ inttostr(AContext.Binding.PeerPort)
+' Port: ' + inttostr(AContext.Binding.Port));
end;
procedure TForm1.IdTCPServer2Disconnect(AContext: TIdContext);
begin
memo1.Lines.Add(AContext.Binding.IP + ' On Port: '+ inttostr(AContext.Binding.port)+ ' DisConnected');
memo1.Lines.Add('Peer Ip: '+ AContext.Binding.PeerIP +' On Peer Port: '+ inttostr(AContext.Binding.PeerPort)
+' Port: ' + inttostr(AContext.Binding.Port));
end;
procedure TForm1.IdTCPServer2Execute(AContext: TIdContext);
var
str_tmp: string;
begin
memo1.Lines.Add('Socket2 Listening___ for 5s');
try
AContext.Connection.IOHandler.ReadTimeout:= 5000;
str_tmp:= AContext.Connection.IOHandler.ReadLn();
if AContext.Connection.IOHandler.ReadLnTimedout then
memo1.Lines.Add('Socket2 Timeout.')
else
begin
memo1.Lines.Add('S2<<'+ str_tmp);
AContext.Connection.IOHandler.WriteLn(str_tmp + '!Send Back!');
memo1.Lines.Add('S2>>'+ str_tmp + '!Send Back!' );
end;
Except
memo1.Lines.Add('Socket2 Err');
end;
end;
end.
解决方案
属性设置器TIdTCPServer.Active
停用侦听并断开所有活动客户端。您无需手动执行任何操作。只需设置Active=False
并让TIdTCPServer
您为您处理其余的事情。
至于您的应用程序没有响应,这可能是由于两个原因:
您正在事件处理程序中访问您的
TMemo
控件,TIdTCPServer
而无需与主 UI 线程同步。TIdTCPServer
事件在工作线程的上下文中触发,因此在从主 UI 线程外部访问 UI 控件时,您必须同步对 UI 控件的访问。您的
OnExecute
事件处理程序正在吞噬所有 Indy 异常,因此服务器不知道连接何时关闭,因此它们可以终止其线程。这反过来又阻塞了Active
属性设置器,它等待所有活动的客户端线程终止。如果在捕获 Indy 异常时没有手动Disconnect()
连接,则需要重新引发异常并让服务器处理它。
尝试更多类似的东西:
unit port_test;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdTCPServer, Vcl.StdCtrls, IdContext;
type
TForm1 = class(TForm)
Memo1: TMemo;
IdTCPServer1: TIdTCPServer;
IdTCPServer2: TIdTCPServer;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer2Connect(AContext: TIdContext);
procedure IdTCPServer2Disconnect(AContext: TIdContext);
procedure IdTCPServer1Disconnect(AContext: TIdContext);
procedure FormCreate(Sender: TObject);
procedure IdTCPServer1Execute(AContext: TIdContext);
procedure IdTCPServer2Execute(AContext: TIdContext);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure AddToMemo(const S: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AddToMemo(const S: string);
begin
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add(S);
end
);
end;
procedure TForm1.Button1Click(Sender: TObject);//active or deactive socket1
var
i: integer;
begin
if IdTCPServer1.Active then
begin
IdTCPServer1.Active := False;
Button1.Caption := 'Listening';
end
else
begin
IdTCPServer1.Bindings.Clear;
IdTCPServer1.DefaultPort := StrToInt(Edit1.Text);
IdTCPServer1.Active := True;
Button1.Caption := 'Release';
end;
end;
procedure TForm1.Button2Click(Sender: TObject);////active or deactive socket1
begin
if IdTCPServer2.Active then
begin
IdTCPServer2.Active := False;
Button2.Caption := 'Listening';
end
else
begin
IdTCPServer2.Bindings.Clear;
IdTCPServer2.DefaultPort := StrToInt(Edit2.Text);
IdTCPServer2.Active := True;
Button2.Caption := 'Release';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
AddToMemo(AContext.Binding.IP + ' On Port: ' + IntToStr(AContext.Binding.Port) + ' Connected');
AddToMemo('Peer Ip: ' + AContext.Binding.PeerIP + ' On Peer Port: ' + IntToStr(AContext.Binding.PeerPort) + ' Port: ' + IntToStr(AContext.Binding.Port));
AContext.Connection.IOHandler.ReadTimeout := 5000;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
AddToMemo(AContext.Binding.IP + ' On Port: ' + IntToStr(AContext.Binding.Port) + ' DisConnected');
AddToMemo('Peer Ip: '+ AContext.Binding.PeerIP +' On Peer Port: '+ IntToStr(AContext.Binding.PeerPort) + ' Port: ' + IntToStr(AContext.Binding.Port));
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
str_tmp: string;
begin
AddToMemo('Socket1 Listening___ for 5s');
try
str_tmp := AContext.Connection.IOHandler.ReadLn();
if AContext.Connection.IOHandler.ReadLnTimedout then
AddToMemo('Socket1 Timeout.')
else
begin
AddToMemo('S1<<' + str_tmp);
AContext.Connection.IOHandler.WriteLn(str_tmp + '!Send Back!');
AddToMemo('S1>>' + str_tmp + '!Send Back!');
end;
except
AddToMemo('Socket1 Err');
raise;
end;
end;
procedure TForm1.IdTCPServer2Connect(AContext: TIdContext);
begin
AddToMemo(AContext.Binding.IP + ' On Port: ' + IntToStr(AContext.Binding.Port) + ' Connected');
AddToMemo('Peer Ip: '+ AContext.Binding.PeerIP + ' On Peer Port: ' + IntToStr(AContext.Binding.PeerPort) + ' Port: ' + IntToStr(AContext.Binding.Port));
AContext.Connection.IOHandler.ReadTimeout := 5000;
end;
procedure TForm1.IdTCPServer2Disconnect(AContext: TIdContext);
begin
AddToMemo(AContext.Binding.IP + ' On Port: '+ IntToStr(AContext.Binding.Port) + ' DisConnected');
AddToMemo('Peer Ip: ' + AContext.Binding.PeerIP + ' On Peer Port: ' + IntToStr(AContext.Binding.PeerPort) + ' Port: ' + IntToStr(AContext.Binding.Port));
end;
procedure TForm1.IdTCPServer2Execute(AContext: TIdContext);
var
str_tmp: string;
begin
AddToMemo('Socket2 Listening___ for 5s');
try
str_tmp := AContext.Connection.IOHandler.ReadLn();
if AContext.Connection.IOHandler.ReadLnTimedout then
AddToMemo('Socket2 Timeout.')
else
begin
AddToMemo('S2<<' + str_tmp);
AContext.Connection.IOHandler.WriteLn(str_tmp + '!Send Back!');
AddToMemo('S2>>' + str_tmp + '!Send Back!' );
end;
except
AddToMemo('Socket2 Err');
raise;
end;
end;
end.
推荐阅读
- sql-server - HIbernate 工具 org.hibernate.exception.JDBCConnectionException:调用 Driver#connect 时出错
- javascript - 如何创建可以从 Python 调用的 JavaScript API?
- c# - MVVM 结构:在 MVVM 中将文件发送到服务器的位置在哪里?
- haskell - 双函子与箭头方法
- bash - 如果第一列匹配,则处理第二列
- javascript - 如何对 keydown 和 click 事件使用相同的功能?
- macos - 移植一个Window专用工具到macOS,这个工具可以修改其他应用程序的属性
- python - 无法在 django 应用程序上显示外键属性
- sql - SQL Server - 成功插入语句但未加载记录
- python - Django项目中的国家/地区访问限制