Search code examples
delphitcpclient

TCPClient : Custom timeout time


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 :)


Solution

  • 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.