1

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

我基于流行的屏幕捕获程序制作了服务器和客户端程序：

ScreenThief - 通过网络窃取屏幕截图

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

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

显然，服务器似乎资源不足，无法接受更多的客户端连接。

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

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

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

以下是客户端和服务器的来源，以便你们测试它们：

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

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

谁能帮我 ？雷米勒博？

4

1 回答 1

3

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.
于 2014-12-26T21:44:59.997 回答