Search code examples
delphitcpclientwinsockindy

TcpClient giving errors at thread execute at connect and write

I'm having a problem on a laptop connection to TIdTCPServer. The thing is, it connects fine, sends a command, but when it tries to send it again, it gets socket error 10053 or 10004 or 10054.

The same code on other computers works fine, just on this one laptop this error happens.

I'm using a connection in a thread, here is the code:

type
  TThreadCon = class(TThread)
  private
    TCPClient : TIdTCPClient;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

procedure DJWRZORLBS(millisecs: Integer);
var
  tick    : dword;
  AnEvent : THandle;
begin
  AnEvent := CreateEvent(nil, False, False, nil);
  try
    tick := GetTickCount + dword(millisecs);
    while (millisecs > 0) and (MsgWaitForMultipleObjects(1, AnEvent, False, millisecs, QS_ALLINPUT) <> WAIT_TIMEOUT) do begin
      Application.ProcessMessages;
      if Application.Terminated then Exit;
      millisecs := tick - GetTickcount;
    end;
  finally
    CloseHandle(AnEvent);
  end;
end;

constructor TThreadCon.Create;
begin
  inherited Create(True);
  TCPClient := TIdTCPClient.Create(Nil);
  TCPClient.ReadTimeout     := 3*60000;
  TCPClient.ConnectTimeout  := 3*60000;
  TCPClient.Port            := StrToInt(PortaPS);
  TCPClient.Host            := Host;
  TCPClient.IPVersion       := Id_IPv4;
  TCPClient.UseNagle        := True;
  TCPClient.ReuseSocket     := rsOSDependent;
end;

procedure TThreadCon.Execute;
begin
  while True do
  begin
    //Sleep(2500);

    try
      if not TCPClient.Connected then
      begin
        TCPClient.Connect;

        if TCPClient.Connected then
        begin
          Attempts:= 0;
          WriteLn(Format('[%s] Connected to server. [%d]', [TimeToStr(Now), Attempts]));

          TCPClient.IOHandler.WriteLn('connect');    
          if rt = nil then rt := TReadingThread.Create(TCPClient);
        end;
      end
      else
      begin
        LastPing:= GetTickCount;

        try
          TCPClient.IOHandler.WriteLn('Ping');
        except
          on E: Exception do
          begin
            WriteLn(Format('[%s] Error while trying send ping: %s', [TimeToStr(Now), E.Message]));
          end;
        end;

        WriteLn(Format('[%s] Ping send, Last Ping [%d]', [TimeToStr(Now), GetTickCount-LastPing]));
      end;
    except
      on E: Exception do
      begin
        Inc(Attempts);

        TCPClient.Disconnect(False);
        if TCPClient.IOHandler <> nil then TCPClient.IOHandler.InputBuffer.Clear;

        WriteLn(Format('[%s] Failed to connect, error: %s [%d]', [TimeToStr(Now), E.Message, Attempts]));
      end;
    end;

    DJWRZORLBS(5000);
  end;
end;

Below is the Console log where the problem happens. It connects to the server, then when the thread runs again, where it should send Ping starts the problems, and for some reason in some cases it always shows as connected at every thread run, like TCPClient.Connected isn't connected.

image

This is a normal log on a computer that works fine:

[21:44:59] Connected to server. [0]
[21:45:04] Ping send, Last Ping [0]
[21:45:09] Ping send, Last Ping [0]

if I close the server, wait some seconds and reopen, it shows as this:

[21:45:54] Failed to connect, error: Socket Error # 10054
Connection reset by peer. [1]
[21:46:01] Failed to connect, error: Socket Error # 10061
Connection refused. [2]
[21:46:08] Failed to connect, error: Socket Error # 10061
Connection refused. [3]
[21:46:14] Connected to server. [0]
[21:46:19] Ping send, Last Ping [0]

For me, it's how it should work correctly.

What can cause this? Some problem on the server? But if it is at the server, why do other machines work fine?

Some network setting? If yes, what can I do to solve it?

Solution

  • Internally, Connected performs a reading operation, which is not a good thing in your case since you have another thread that reads from the same socket at the same time if Connect() is successful. The two threads will fight over access to the socket and putting data into its IOHandler.InputBuffer.

    In any case, Connected returns True if there is any unread data in the InputBuffer, even if the underlying socket fails.

    Your TThreadCon is not structured very well. I would suggest restructuring it to eliminate the need for using Connected at all (and DJWRZORLBS(), since TThreadCon does not have a message queue that needs to be pumped). A better design would be to have the thread connect in a loop until successful, then send pings in a loop, then disconnect, and repeat as needed.

    Try something more like this:

    type
  TThreadCon = class(TThread)
  private
    FTermEvent: TEvent;
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
    procedure TerminatedSet; override;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;

constructor TThreadCon.Create;
begin
  inherited Create(True);
  FTermEvent := TEvent.Create;
end;

destructor TThreadCon.Destroy;
begin
  FTermEvent.Free;
  inherited;
end;

procedure TThreadCon.TerminatedSet;
begin
  FTermEvent.SetEvent;
end;

procedure TThreadCon.Execute;
var
  TCPClient: TIdTCPClient;
  rt: TReadingThread;
  Attempts: Integer;
begin
  TCPClient := TIdTCPClient.Create(nil);
  try
    TCPClient.ReadTimeout     := 3*60000;
    TCPClient.ConnectTimeout  := 3*60000;
    TCPClient.Port            := StrToInt(PortaPS);
    TCPClient.Host            := Host;
    TCPClient.IPVersion       := Id_IPv4;
    TCPClient.UseNagle        := True;
    TCPClient.ReuseSocket     := rsOSDependent;

    Attempts := 0;

    while not Terminated do
    begin
      if TCPClient.IOHandler <> nil then
        TCPClient.IOHandler.InputBuffer.Clear;

      try
        TCPClient.Connect;
        try
          TCPClient.IOHandler.WriteLn('connect');    
        except
          TCPClient.Disconnect(False);
          raise;
        end;
      except
        on E: Exception do
        begin
          Inc(Attempts);
          WriteLn(Format('[%s] Failed to connect, error: %s [%d]', [TimeToStr(Now), E.Message, Attempts]));
          if FTermEvent.WaitFor(2500) <> wrTimeout then Exit;
          Continue;
        end;
      end;

      Attempts := 0;
      WriteLn(Format('[%s] Connected to server.', [TimeToStr(Now)]));

      rt := TReadingThread.Create(TCPClient);
      try
        try
          while not Terminated do
          begin
            LastPing := GetTickCount;      
            TCPClient.IOHandler.WriteLn('Ping');
            WriteLn(Format('[%s] Ping send, Last Ping [%d]', [TimeToStr(Now), GetTickCount-LastPing]));
            if FTermEvent.WaitFor(5000) <> wrTimeout then Exit;
          end;
        except
          on E: Exception do
          begin
            WriteLn(Format('[%s] Error while trying to send ping: %s', [TimeToStr(Now), E.Message]));
          end;
        end;            
      finally
        rt.Terminate;
        try
          TCPClient.Disconnect(False);
        finally
          rt.WaitFor;
          rt.Free;
        end;
      end;
    end;
  finally
    TCPClient.Free;
  end;
end;

procedure TThreadCon.DoTerminate;
begin
  if FatalException <> nil then
    WriteLn(Format('[%s] Fatal Error: %s', [TimeToStr(Now), Exception(E).Message]));
  inherited;
end;