delphi - ストレステスト実行時のtcpserver x tcpclientの問題

Question

TCPServer と TcpClient の問題について助けが必要です。Delphi XE2 と Indy 10.5 を使用しています。

一般的なスクリーン キャプチャ プログラムに基づいて、サーバー プログラムとクライアント プログラムを作成しました。

ScreenThief - ネットワーク経由でスクリーン ショットを盗む

私のクライアント プログラムは、.zipファイルと一部のデータをサーバーに送信します。これは通常、個別に数回機能しますが、タイマーを介して 5 秒間に 5 回送信が実行されるストレス テストに入れると、試行 #63 で、クライアントはサーバーに接続できなくなります。

ソケット エラー #10053
ソフトウェアが原因で接続が中止されました。

どうやら、サーバーのリソースが不足していて、それ以上のクライアント接続を受け入れることができないようです。

エラー メッセージの後、サーバーに接続できません。個々のテストでも、ストレス テストでも接続できません。クライアントを終了して再起動しても、エラーは解決しません。サーバーを終了して再起動する必要があります。その後、クライアントは再び接続できます。

クライアントでソケット エラー #10054 が発生することがあり、これによりサーバーが完全にクラッシュし、再起動する必要があります。

何が起こっているのかわかりません。サーバーを時々再起動する必要がある場合、それは堅牢なサーバーではないことを知っています.

テストできるように、クライアントとサーバーのソースを次に示します。

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

サーバーを実行し、クライアントを実行し、「無限に実行するためにチェックするだけ」にチェックを入れます。テストでは、サーバーは で実行されlocalhostます。

誰でも私を助けることができますか？レミー・ルボー?

Answer 1

I see problems with your client code.

1. You are assigning TCPClient.OnConnected and TCPClient.OnDisconnected event handlers after calling TCPClient.Connect(). You should be assigning them before calling Connect().

2. you are assigning TCPClient.IOHandler.DefStringEncoding after sending all of your data. You should be setting it before sending any data.

3. You are sending the .zip file size as bytes, but then sending the actual file content using a TStringStream. You need to use a TFileStream or TMemoryStream instead. Also, you can get the file size from the stream, you don't have to query the file size before then creating the stream.

4. You have a complete lack of error handling. If any exception is raised while btnRunClick() is running, you are leaking your TIdTCPClient object and not disconnecting it from the server.

I see some problems with your server code as well:

1. your OnCreate event is activating the server before the Clients list has been created.

2. various misuse of TThread.LockList() and TThreadList.Unlock().

3. using InputBufferIsEmpty() and TRTLCriticalSection unnecessarily.

4. lack of error handling.

5. using TIdAntiFreeze, which has no effect on servers.

Try this instead:

Client:

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.

Server:

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.