Delphi tcpserver x tcpclient在运行压力测试时出现问题

我需要帮助解决TCPServer和TcpClient问题。我正在使用Delphi XE2和Indy 10.5

我根据一个流行的屏幕捕获程序制作了服务器和客户端程序：

我的客户端程序向服务器发送一个

.zip

文件和一些数据。这通常会单独工作几次，但如果我将其置于压力测试中，即通过计时器在5秒内执行5次传输，则恰好在尝试时#63客户端无法再连接到服务器：

套接字错误#10053
软件导致中断连接

显然，服务器似乎已耗尽资源，无法再接受任何客户端连接

在收到错误消息后，我无法以任何方式连接到服务器-不是在单个测试中，也不是在压力测试中。即使退出并重新启动客户端，错误仍然存在。我必须退出并重新启动服务器，然后客户端才能再次连接

有时，客户端发生套接字错误#10054，这会导致服务器完全崩溃，必须重新启动

我不知道发生了什么事。我只知道，如果服务器必须不时重启，那么它就不是一个健壮的服务器

以下是客户端和服务器的源代码，以便您可以测试它们：

运行服务器，运行客户端，并选中“Just check to Run Infinite”。在测试中，服务器在

localhost

中运行

---

有人能帮我吗？Remy Lebeau？

我发现您的客户端代码有问题

调用

TCPClient.Connect（）

后，您正在分配

TCPClient.OnConnected

和

TCPClient.OnDisconnected

事件处理程序。您应该在调用

Connect（）

之前分配它们

发送所有数据后，您正在分配

TCPClient.IOHandler.DefStringEncoding

。您应该在发送任何数据之前进行设置

您正在以字节形式发送

.zip

文件大小，但随后使用

TStringStream

发送实际文件内容。您需要使用

TFileStream

或

TMemoryStream

。此外，您可以从流中获取文件大小，在创建流之前不必查询文件大小

您完全没有错误处理能力。如果在运行

btnRunClick（）

时引发任何异常，则表明您正在泄漏

TIdTCPClient

对象，并且没有将其与服务器断开连接

我发现您的服务器代码也存在一些问题：

您的

OnCreate

事件正在创建

客户端

列表之前激活服务器

对

TThread.LockList（）

和

TThreadList.Unlock（）

的各种误用

不必要地使用

InputBufferIsEmpty（）

和

TRTLCriticalSection

缺少错误处理

使用

tid防冻液

，对服务器没有影响

请尝试以下方法：

客户：

unit ComunicaClientForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
  IdAntiFreezeBase, Vcl.IdAntiFreeze, Vcl.Samples.Spin, Vcl.ExtCtrls,
  IdComponent, IdTCPConnection, IdTCPClient,  idGlobal;

type
  TfrmComunicaClient = class(TForm)
    memoIncomingMessages: TMemo;
    IdAntiFreeze: TIdAntiFreeze;
    lblProtocolLabel: TLabel;
    Timer: TTimer;
    grp1: TGroupBox;
    grp2: TGroupBox;
    btnRun: TButton;
    chkIntervalado: TCheckBox;
    spIntervalo: TSpinEdit;
    lblFrequencia: TLabel;
    lbl1: TLabel;
    lbl2: TLabel;
    lblNumberExec: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure TCPClientConnected(Sender: TObject);
    procedure TCPClientDisconnected(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure chkIntervaladoClick(Sender: TObject);
    procedure btnRunClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmComunicaClient: TfrmComunicaClient;

implementation

{$R *.dfm}

const
  DefaultServerIP = '127.0.0.1';
  DefaultServerPort = 7676;

procedure TfrmComunicaClient.FormCreate(Sender: TObject);
begin
  memoIncomingMessages.Clear;
end;

procedure TfrmComunicaClient.TCPClientConnected(Sender: TObject);
begin
  memoIncomingMessages.Lines.Insert(0,'Connected to Server');
end;

procedure TfrmComunicaClient.TCPClientDisconnected(Sender: TObject);
begin
  memoIncomingMessages.Lines.Insert(0,'Disconnected from Server');
end;

procedure TfrmComunicaClient.TimerTimer(Sender: TObject);
begin
  Timer.Enabled := False;
  btnRun.Click;
  Timer.Enabled := True;
end;

procedure TfrmComunicaClient.chkIntervaladoClick(Sender: TObject);
begin
  Timer.Interval := spIntervalo.Value * 1000;
  Timer.Enabled := True;
end;

procedure TfrmComunicaClient.btnRunClick(Sender: TObject);
var
  Size        : Int64;
  fStrm       : TFileStream;
  NomeArq     : String;
  Retorno     : string;
  TipoRetorno : Integer; // 1 - Anvisa, 2 - Exception
  TCPClient   : TIdTCPClient;    
begin
  memoIncomingMessages.Lines.Clear;

  TCPClient := TIdTCPClient.Create(nil);
  try
    TCPClient.Host := DefaultServerIP;
    TCPClient.Port := DefaultServerPort;
    TCPClient.ConnectTimeout := 3000;
    TCPClient.OnConnected := TCPClientConnected;
    TCPClient.OnDisconnected := TCPClientDisconnected;

    TCPClient.Connect;
    try
      TCPClient.IOHandler.DefStringEncoding := TIdTextEncoding.UTF8;

      TCPClient.IOHandler.WriteLn('SendArq'); // Sinaliza Envio
      TCPClient.IOHandler.WriteLn('1'); // Envia CNPJ
      TCPClient.IOHandler.WriteLn('email@gmail.com'); // Envia Email
      TCPClient.IOHandler.WriteLn('12345678'); // Envia Senha
      TCPClient.IOHandler.WriteLn('12345678901234567890123456789012'); // Envia hash
      memoIncomingMessages.Lines.Insert(0,'Write first data : ' + DateTimeToStr(Now));

      NomeArq := ExtractFilePath(Application.ExeName) + 'arquivo.zip';
      fStrm := TFileStream.Create(NomeArq, fmOpenRead or fmShareDenyWrite);
      try
        Size := fStrm.Size;
        TCPClient.IOHandler.WriteLn(IntToStr(Size));
        if Size > 0 then begin
          TCPClient.IOHandler.Write(fStrm, Size, False);
        end;
      finally
        fStrm.Free;
      end;
      memoIncomingMessages.Lines.Insert(0,'Write file: ' + DateTimeToStr(Now) + ' ' +IntToStr(Size)+ ' bytes');
      memoIncomingMessages.Lines.Insert(0,'************* END *********** ' );
      memoIncomingMessages.Lines.Insert(0,'  ');

      // Recebe Retorno da transmissão
      TipoRetorno := StrToInt(TCPClient.IOHandler.ReadLn);
      Retorno := TCPClient.IOHandler.ReadLn;

      //making sure!
      TCPClient.IOHandler.ReadLn;
    finally
      TCPClient.Disconnect;
    end;
  finally
    TCPClient.Free;
  end;

  lblNumberExec.Caption := IntToStr(StrToInt(lblNumberExec.Caption) + 1);
end;

end.

服务器：

unit ComunicaServerForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  IdCustomTCPServer, IdTCPServer, IdScheduler, IdSchedulerOfThread,
  IdSchedulerOfThreadPool, IdBaseComponent, IdSocketHandle, Vcl.ExtCtrls,
  IdStack, IdGlobal, Inifiles, System.Types, IdContext, IdComponent;


type
  TfrmComunicaServer = class(TForm)
    txtInfoLabel: TStaticText;
    mmoProtocol: TMemo;
    grpClientsBox: TGroupBox;
    lstClientsListBox: TListBox;
    grpDetailsBox: TGroupBox;
    mmoDetailsMemo: TMemo;
    lblNome: TLabel;
    TCPServer: TIdTCPServer;
    ThreadManager: TIdSchedulerOfThreadPool;
    procedure lstClientsListBoxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TCPServerConnect(AContext: TIdContext);
    procedure TCPServerDisconnect(AContext: TIdContext);
    procedure TCPServerExecute(AContext: TIdContext);
  private
    { Private declarations }
    procedure RefreshListDisplay;
    procedure RefreshListBox;
  public
    { Public declarations }
  end;

var
  frmComunicaServer: TfrmComunicaServer;

implementation

{$R *.dfm}

type
  TClient = class(TIdServerContext)
  public
    PeerIP      : string;            { Client IP address }
    HostName    : String;            { Hostname }
    Connected,                       { Time of connect }
    LastAction  : TDateTime;         { Time of last transaction }
  end;

const
  DefaultServerIP = '127.0.0.1';
  DefaultServerPort = 7676;

procedure TfrmComunicaServer.FormCreate(Sender: TObject);
begin
  TCPServer.ContextClass := TClient;

  TCPServer.Bindings.Clear;
  with TCPServer.Bindings.Add do
  begin
    IP := DefaultServerIP;
    Port := DefaultServerPort;
  end;

  //setup TCPServer
  try
    TCPServer.Active := True;
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;

  txtInfoLabel.Caption := 'Aguardando conexões...';
  RefreshListBox;

  if TCPServer.Active then begin
    mmoProtocol.Lines.Add('Comunica Server executando em ' + TCPServer.Bindings[0].IP + ':' + IntToStr(TCPServer.Bindings[0].Port));
  end;
end;

procedure TfrmComunicaServer.FormClose(Sender: TObject; var Action: TCloseAction);
var
  ClientsCount : Integer;
begin
  with TCPServer.Contexts.LockList do
  try
    ClientsCount := Count;
  finally
    TCPServer.Contexts.UnlockList;
  end;

  if ClientsCount > 0 then
  begin
    Action := caNone;
    ShowMessage('Há clientes conectados. Ainda não posso sair!');
    Exit;
  end;

  try
    TCPServer.Active := False;
  except
  end;
end;

procedure TfrmComunicaServer.TCPServerConnect(AContext: TIdContext);
var
  DadosConexao : TClient;
begin
  DadosConexao := TClient(AContext);

  DadosConexao.PeerIP      := AContext.Connection.Socket.Binding.PeerIP;
  DadosConexao.HostName    := GStack.HostByAddress(DadosConexao.PeerIP);
  DadosConexao.Connected   := Now;
  DadosConexao.LastAction  := DadosConexao.Connected;

  (*
  TThread.Queue(nil,
    procedure
    begin
      MMOProtocol.Lines.Add(TimeToStr(Time) + ' Abriu conexão de "' + DadosConexao.HostName + '" em ' + DadosConexao.PeerIP);
    end
  );
  *)

  RefreshListBox;
  AContext.Connection.IOHandler.DefStringEncoding := TIdTextEncoding.UTF8;
end;    

procedure TfrmComunicaServer.TCPServerDisconnect(AContext: TIdContext);
var
  DadosConexao : TClient;
begin
  DadosConexao := TClient(AContext);

  (*
  TThread.Queue(nil,
    procedure
    begin
      MMOProtocol.Lines.Add(TimeToStr(Time) + ' Desconnectado de "' + DadosConexao.HostName + '"');
    end
  );
  *)

  RefreshListBox;
end;    

procedure TfrmComunicaServer.TCPServerExecute(AContext: TIdContext);
var
  DadosConexao : TClient;
  CNPJ         : string;
  Email        : string;
  Senha        : String;
  Hash         : String;
  Size         : Int64;
  FileName     : string;
  Arquivo      : String;
  ftmpStream   : TFileStream;
  Cmd          : String;
  Retorno      : String;
  TipoRetorno  : Integer;   // 1 - Anvisa, 2 - Exception
begin
  DadosConexao := TClient(AContext);

  Cmd := AContext.Connection.IOHandler.ReadLn;

  if Cmd = 'SendArq' then
  begin
    CNPJ  := AContext.Connection.IOHandler.ReadLn;
    Email := AContext.Connection.IOHandler.ReadLn;
    Senha := AContext.Connection.IOHandler.ReadLn;
    Hash  := AContext.Connection.IOHandler.ReadLn;
    Size  := StrToInt64(AContext.Connection.IOHandler.ReadLn);

    // Recebe Arquivo do Client
    FileName := ExtractFilePath(Application.ExeName) + 'Arquivos\' + CNPJ + '-Arquivo.ZIP';
    fTmpStream := TFileStream.Create(FileName, fmCreate);
    try
      if Size > 0 then begin
        AContext.Connection.IOHandler.ReadStream(fTmpStream, Size, False);
      end;
    finally
      fTmpStream.Free;
    end;

    // Transmite arquivo para a ANVISA
    Retorno     := 'File Transmitted with sucessfull';
    TipoRetorno := 1;

    // Grava Log
    fTmpStream := TFileStream.Create(ExtractFilePath(Application.ExeName) + 'Arquivos\' + CNPJ + '.log', fmCreate);
    try
      WriteStringToStream(ftmpStream, Retorno, TIdTextEncoding.UTF8);
    finally
      fTmpStream.Free;
    end;    

    // Envia Retorno da ANVISA para o Client
    AContext.Connection.IOHandler.WriteLn(IntToStr(TipoRetorno));  // Tipo do retorno (Anvisa ou Exception)
    AContext.Connection.IOHandler.WriteLn(Retorno);                // Msg de retorno

    // Sinaliza ao Client que terminou o processo
    AContext.Connection.IOHandler.WriteLn('DONE');
  end;
end;

procedure TfrmComunicaServer.lstClientsListBoxClick(Sender: TObject);
var
  DadosConexao: TClient;
  Index: Integer;
begin
  mmoDetailsMemo.Clear;

  Index := lstClientsListBox.ItemIndex;
  if Index <> -1 then
  begin
    DadosConexao := TClient(lstClientsListBox.Items.Objects[Index]);
    with TCPServer.Contexts.LockList do
    try
      if IndexOf(DadosConexao) <> -1 then
      begin
        mmoDetailsMemo.Lines.Add('IP : ' + DadosConexao.PeerIP);
        mmoDetailsMemo.Lines.Add('Host name : ' + DadosConexao.HostName);
        mmoDetailsMemo.Lines.Add('Conectado : ' + DateTimeToStr(DadosConexao.Connected));
        mmoDetailsMemo.Lines.Add('Ult. ação : ' + DateTimeToStr(DadosConexao.LastAction));
      end;
    finally
      TCPServer.Contexts.UnlockList;
    end;
  end;
end;

procedure TfrmComunicaServer.RefreshListDisplay;
var
  Client : TClient;
  i: Integer;
begin
  lstClientsListBox.Clear;
  mmoDetailsMemo.Clear;

  with TCPServer.Contexts.LockList do
  try
    for i := 0 to Count-1 do
    begin
      Client := TClient(Items[i]);
      lstClientsListBox.AddItem(Client.HostName, Client);
    end;
  finally
    TCPServer.Contexts.UnlockList;
  end;
end;    

procedure TfrmComunicaServer.RefreshListBox;
begin
  if GetCurrentThreadId = MainThreadID then
    RefreshListDisplay
  else
    TThread.Queue(nil, RefreshListDisplay);
end;

end.

单元通信服务器表单；
接口
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.Variants、System.Classes、Vcl.Graphics、，
Vcl.控件、Vcl.窗体、Vcl.对话框、Vcl.stdctrl、，
IdCustomTCPServer、IdTCPServer、IdScheduler、IdSchedulerOfThread、，
IdSchedulerOfThreadPool、IdBaseComponent、IdSocketHandle、Vcl.ExtCtrls、，
IdStack、IdGlobal、Inifiles、System.Types、IdContext、IdComponent；
类型
TFRMComunicationServer=类（TForm）
txtInfoLabel:TStaticText；
MMO协议：TMemo；
grpClientsBox:TGroupBox；
lstClientsListBox:TListBox；
grpDetailsBox:TGroupBox；
MMOMO:TMemo；
lblNome:TLabel；
TCPServer:TIdTCPServer；
ThreadManager:TIdSchedulerOfThreadPool；
程序lstClientsListBoxClick（发送方：TObject）；
过程表单创建（发送方：ToObject）；
过程FormClose（发送方：ToObject；var操作：TCloseAction）；
过程TCPServerConnect（AContext:TIdContext）；
程序TCPServerDisconnect（AContext:TIdContext）；
过程TCPServerExecute（AContext:TIdContext）；
私有的
{私有声明}
程序刷新列表显示；
程序刷新列表框；
公众的
{公开声明}
结束；
变量
frmcom通信服务器：tfrmcom通信服务器；
实施
{$R*.dfm}
类型
TClient=class（TIdServerContext）
公众的
PeerIP：字符串；{客户端IP地址}
主机名：字符串；{Hostname}
已连接，{连接时间}
最后一个动作：TDateTime；{上次交易时间}
结束；
常数
DefaultServerIP='127.0.0.1'；
DefaultServerPort=7676；
过程TfrmComunicaServer.FormCreate（发送方：TObject）；
开始
TCPServer.ContextClass:=TClient；
TCPServer.Bindings.Clear；
使用TCPServer.Bindings.Add do
开始
IP:=默认服务器IP；
端口：=默认服务器端口；
结束；
//设置TCPServer
尝试
TCPServer.Active:=True；
除了
关于E:Exception-do
ShowMessage（E.Message）；
结束；
描述：='Aguardando conexões…'；
刷新列表框；
如果TCPServer.Active处于活动状态，则开始
mmoProtocol.Lines.Add（'Comunica Server executando em'+TCPServer.Bindings[0].IP+'：'+IntToStr（TCPServer.Bindings[0].Port））；
结束；
结束；
过程TfrmComunicaServer.FormClose（发送方：TObject；var操作：TCloseAction）；
变量
客户：整数；
开始
使用TCPServer.Contexts.LockList do
尝试
clientscont:=计数；
最后
TCPServer.Contexts.UnlockList；
结束；
如果ClientScont>0，则
开始
动作：=佳能；
ShowMessage（'Háclientes conectados.Ainda não posso sair！'）；
出口
结束；
尝试
TCPServer.Active:=False；
除了
结束；
结束；
过程TfrmComunicaServer.TCPServerConnect（AContext:TIdContext）；
变量
DadosConexao:TClient；
开始
DadosConexao:=TClient（AContext）；
DadosConexao.PeerIP:=AContext.Connection。