安全关闭IdTCPServer中来自服务器的所有连接

时间：2019-07-18 00:23:07

标签： delphi-10.2-tokyo

我正在尝试在连接客户端时停用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.

1 个答案:

答案 0 :(得分：0)

TIdTCPServer.Active属性设置器将停用侦听，并断开所有活动客户端的连接。您无需手动执行任何操作。只需设置Active=False，然后让TIdTCPServer为您完成其余工作即可。

对于您的应用没有响应，可能是由于两个原因：

  • 您正在TMemo事件处理程序中访问TIdTCPServer控件，而没有与主UI线程同步。 TIdTCPServer事件是在辅助线程的上下文中触发的，因此从主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.
相关问题
最新问题