Поток TIdTcpClient перестает отвечать через некоторое время - PullRequest
Новая
       9

Поток TIdTcpClient перестает отвечать через некоторое время

0 голосов
/ 01 ноября 2018

Через некоторое время мой клиентский поток перестает получать / отправлять команды с / на TIdTcpServer. Вот поток на стороне клиента, который я скопировал из примера с Реми:

Локально протестировано и не происходит, только в работающей среде возникает ошибка ... 

type
  TDataEvent = procedure(const LBuffer: TIdBytes) of object;

  TReadingThread = class(TThread)
  private
    FClient : TIdTCPClient;
    FData   : TIdBytes;
    FOnData : TDataEvent;
    procedure DataReceived;
  protected
    procedure Execute; override;
  public
    constructor Create(AClient: TIdTCPClient); reintroduce;
    property OnData: TDataEvent read FOnData write FOnData;
  end;

constructor TReadingThread.Create(AClient: TIdTCPClient);
begin
  inherited Create(True);
  FClient := AClient;
end;

procedure TReadingThread.Execute;
begin
  while not Terminated do
  begin
    Form1.Cliente.IOHandler.ReadBytes(FData, szProtocol, False);

    if (FData <> nil) and Assigned(FOnData) then Synchronize(DataReceived);
  end;
end;

procedure TReadingThread.DataReceived;
begin
  if Assigned(FOnData) then FOnData(FData);
end;

procedure TForm1.DataReceived(const LBuffer: TIdBytes);
type
  PTBytes   = ^TBytes;
  PTIdBytes = ^TIdBytes;
var
  LDataSize   : Integer;
  LProtocol   : TProtocol;

  LBuffer2    : TBytes;
  LProtocol2  : TProtocol;
begin
  LProtocol := BytesToProtocol(PTBytes(@LBuffer)^);

  case LProtocol.Command of
    cmdHWID:
    begin
      HWID := LProtocol.Sender.HWID;
     end;

    cmdPing:
    begin
      InitProtocol(LProtocol2);
      LProtocol2.Command      := cmdPing;
      LProtocol2.Sender.PBack := GetTickCount;
      LBuffer2                := ProtocolToBytes(LProtocol2);
      Form1.Cliente.IOHandler.Write(PTIdBytes(@LBuffer2)^);
      ClearBuffer(LBuffer2);
    end;
  end;
end;

Некоторое время все работает отлично, но через некоторое время клиентская сторона прекращает прием / отправку. Соединение с сервером, кажется, все еще открыто.

функция для поиска соединения по ip: 

list := IdTCPServer1.Contexts.LockList;
      try
        for i := 0 to list.Count - 1 do
        begin
          ctx := TIdContext(list[i]);
          if ctx.Binding.PeerIP = Edit9.Text then
          begin
            TLog.AddMsg('IP FOUND');

            Achou := True;
            Cliente := TClientContext(ctx);

            SerialCn  := Cliente.Client.HWID;
            IpCn      := Cliente.Client.IP;

            break;
          end;
        end;
      finally
        IdTCPServer1.Contexts.UnlockList;
      end;
...