TCPClient : Custom timeout time

Question

I need to set custom timeout for TTcpClient. I think the default timeout time is about 20-25 seconds but I need to change it to 500ms. Is it possible And How?

procedure TForm1.Button1Click(Sender: TObject);
   begin
     TcpClient2.RemoteHost := '192.168.1.1';
     TcpClient2.RemotePort := '23';
     TcpClient2.Connect;

     tcpclient2.Receiveln();
     tcpclient2.Sendln('admin');
     tcpclient2.Receiveln;
   end;

I tried non-blocking option but the software returns an error after I click on button And I have to do it again 4-5 times. Any help?

Thanks :)

Answer 1

Winsock has no connect timeout, but this can be overcomed.

You have several options:

1. Without threads:

   • Using non-blocking mode: call Connect, then wait using Winsock select function (encapsulated in TBaseSocket Select method inherited by TTcpClient).

   • Using blocking mode: changing temporarily to non-blocking mode and proceeding as in the previous case.

2. With threads: see Remy Lebeau's answer to How to control the connect timeout with the Winsock API?.

3. Use Indy.

Blocking vs non-blocking

Using blocking or non-blocking mode is a very important design decision that will affect many of your code and which you can't easily change afterward.

For example, in non-blocking mode, receive functions (as Receiveln), will not wait until there is enough input available and could return with an empty string. This can be an advantage if is this what you need, but you need to implement some strategy, such as waiting using TcpClient.WaitForData before calling the receive function (in your example, the Receiveln-Sendln-Receiveln will not work as is).

For simple tasks, blocking mode is easier to deal with.

Non-blocking mode

The following function will wait until the connection is successful or the timeout elapses:

function WaitUntilConnected(TcpClient: TTcpClient; Timeout: Integer): Boolean;
var
  writeReady, exceptFlag: Boolean;
begin
  // Select waits until connected or timeout
  TcpClient.Select(nil, @writeReady, @exceptFlag, Timeout);
  Result := writeReady and not exceptFlag;
end;

How to use:

// TcpClient.BlockMode must be bmNonBlocking

TcpClient.Connect; // will return immediately
if WaitUntilConnected(TcpClient, 500) then begin // wait up to 500ms
  ... your code here ...
end;

Also be aware of the following drawbacks/flaws in TTcpClient's non-blocking mode design:

• Several functions will call OnError with SocketError set to WSAEWOULDBLOCK (10035).
• Connected property will be false because is assigned in Connect.

Blocking mode

Connection timeout can be achieved by changing to non-blocking mode after socket is created but before calling Connect, and reverting back to blocking mode after calling it.

This is a bit more complicated because TTcpClient closes the connection and the socket if we change BlockMode, and also there is not direct way of creating the socket separately from connecting it.

To solve this, we need to hook after socket creation but before connection. This can be done using either the DoCreateHandle protected method or the OnCreateHandle event.

The best way is to derive a class from TTcpClient and use DoCreateHandle, but if for any reason you need to use TTcpClient directly without the derived class, the code can be easily rewriten using OnCreateHandle.

type
  TExtendedTcpClient = class(TTcpClient)
  private
    FIsConnected: boolean;
    FNonBlockingModeRequested, FNonBlockingModeSuccess: boolean;
  protected
    procedure Open; override;
    procedure Close; override;
    procedure DoCreateHandle; override;
    function SetBlockModeWithoutClosing(Block: Boolean): Boolean;
    function WaitUntilConnected(Timeout: Integer): Boolean;
  public
    function ConnectWithTimeout(Timeout: Integer): Boolean;
    property IsConnected: boolean read FIsConnected;
  end;

procedure TExtendedTcpClient.Open;
begin
  try
    inherited;
  finally
    FNonBlockingModeRequested := false;
  end;
end;

procedure TExtendedTcpClient.DoCreateHandle;
begin
  inherited;
  // DoCreateHandle is called after WinSock.socket and before WinSock.connect
  if FNonBlockingModeRequested then
    FNonBlockingModeSuccess := SetBlockModeWithoutClosing(false);
end;

procedure TExtendedTcpClient.Close;
begin
  FIsConnected := false;
  inherited;
end;

function TExtendedTcpClient.SetBlockModeWithoutClosing(Block: Boolean): Boolean;
var
  nonBlock: Integer;
begin
  // TTcpClient.SetBlockMode closes the connection and the socket
  nonBlock := Ord(not Block);
  Result := ErrorCheck(ioctlsocket(Handle, FIONBIO, nonBlock)) <> SOCKET_ERROR;
end;

function TExtendedTcpClient.WaitUntilConnected(Timeout: Integer): Boolean;
var
  writeReady, exceptFlag: Boolean;
begin
  // Select waits until connected or timeout
  Select(nil, @writeReady, @exceptFlag, Timeout);
  Result := writeReady and not exceptFlag;
end;

function TExtendedTcpClient.ConnectWithTimeout(Timeout: Integer): Boolean;
begin
  if Connected or FIsConnected then
    Result := true
  else begin
    if BlockMode = bmNonBlocking then begin
      if Connect then // will return immediately, tipically with false
        Result := true
      else
        Result := WaitUntilConnected(Timeout);
    end
    else begin // blocking mode
      // switch to non-blocking before trying to do the real connection
      FNonBlockingModeRequested := true;
      FNonBlockingModeSuccess := false;
      try
        if Connect then // will return immediately, tipically with false
          Result := true
        else begin
          if not FNonBlockingModeSuccess then
            Result := false
          else
            Result := WaitUntilConnected(Timeout);
        end;
      finally
        if FNonBlockingModeSuccess then begin
          // revert back to blocking
          if not SetBlockModeWithoutClosing(true) then begin
            // undesirable state => abort connection
            Close;
            Result := false;
          end;
        end;
      end;
    end;
  end;
  FIsConnected := Result;
end;

How to use:

TcpClient := TExtendedTcpClient.Create(nil);
try
  TcpClient.BlockMode := bmBlocking; // can also be bmNonBlocking

  TcpClient.RemoteHost := 'www.google.com';
  TcpClient.RemotePort := '80';

  if TcpClient.ConnectWithTimeout(500) then begin // wait up to 500ms
    ... your code here ...
  end;
finally
  TcpClient.Free;
end;

As noted before, Connected doesn't work well with non-blocking sockets, so I added a new IsConnected property to overcome this (only works when connecting with ConnectWithTimeout).

Both ConnectWithTimeout and IsConnected will work with both blocking and non-blocking sockets.