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

Question

我需要有关 TCPServer 和 TcpClient 问题的帮助。我正在使用 Delphi XE2 和 Indy 10.5。

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

ScreenThief - stealing screen shots over the Network

我的客户端程序向服务器发送一个 .zip 文件和一些数据。这通常会单独工作几次，但如果我对其进行压力测试，其中通过计时器在 5 秒内执行传输 5 次，恰好在尝试 #63 时，客户端将无法再连接到服务器:

Socket Error # 10053
Software Caused Abort connection .

显然，服务器似乎耗尽了资源，无法接受更多客户端连接。

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

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

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

以下是客户端和服务器的源码，以便大家测试:

http://www.mediafire.com/download/m5hjw59kmscln7v/ComunicaTest.zip

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

有人可以帮助我吗？雷米·勒博？

Answer 1

我发现您的客户端代码存在问题。

1. 您正在调用 TCPClient.Connect()之后分配 TCPClient.OnConnected 和 TCPClient.OnDisconnected 事件处理程序。您应该在调用 Connect() 之前分配它们。

2. 您正在发送所有数据后分配TCPClient.IOHandler.DefStringEncoding。您应该在发送任何数据之前对其进行设置。

3. 您以字节形式发送 .zip 文件大小，然后使用 TStringStream 发送实际文件内容。您需要使用 TFileStream 或 TMemoryStream 来代替。另外，您可以从流中获取文件大小，无需在创建流之前查询文件大小。

4. 您完全缺乏错误处理能力。如果在 btnRunClick() 运行时引发任何异常，则您将泄漏 TIdTCPClient 对象，并且不会将其与服务器断开连接。

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

1. 您的 OnCreate 事件在创建 Clients 列表之前激活服务器。

2. 各种滥用 TThread.LockList() 和 TThreadList.Unlock()。

3. 不必要地使用InputBufferIsEmpty()和TRTLCriticalSection。

4. 缺乏错误处理。

5. 使用 TIdAntiFreeze，这对服务器没有影响。

试试这个:

客户:

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.