TCPClient:自定义超时时间

时间:2013-08-27 19:32:58

标签: delphi tcpclient

我需要为TTcpClient设置自定义超时。我认为默认超时时间约为20-25秒,但我需要将其更改为500毫秒。它有可能吗?如何?

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;

我尝试了non-blocking选项,但是在点击按钮后软件返回错误而我必须再次执行4-5次。有什么帮助吗?

谢谢:)

1 个答案:

答案 0 :(得分:8)

Winsock没有连接超时,但这可以克服。

您有几种选择:

  1. 没有主题:

    • 使用非阻塞模式:调用Connect,然后使用Winsock select函数等待(封装在TTcpClient继承的TBaseSocket Select方法中)。

    • 使用阻止模式:暂时更改为非阻止模式,并按上一种情况继续进行。

  2. 有线索:请参阅Remy Lebeau对How to control the connect timeout with the Winsock API?的回答。

  3. 使用Indy。

  4. 阻止与非阻止

    使用阻止或非阻止模式是一个非常重要的设计决策,会影响您的许多代码,之后您无法轻易更改。

    例如,在非阻塞模式下,接收函数(如Receiveln)不会等到有足够的可用输入并且可以返回空字符串。这可能是一个优势,如果这是你需要的,但你需要实现一些策略,例如在调用接收函数之前等待使用TcpClient.WaitForData(在你的例子中,Receiveln-Sendln-Receiveln将无法正常工作)。

    对于简单的任务,阻止模式更容易处理。

    非阻塞模式

    以下函数将等待连接成功或超时:

    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;
    

    使用方法:

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

    还要注意TTcpClient的非阻塞模式设计中存在以下缺点/缺陷:

    • OnError设置为SocketError(10035)的情况下,多个函数会调用WSAEWOULDBLOCK
    • Connected属性为false,因为已在Connect中分配。

    阻止模式

    连接超时可以通过在创建套接字之后但在调用Connect之前更改为非阻塞模式,并在调用它之后恢复为阻塞模式来实现。

    这有点复杂,因为如果我们更改TTcpClient BlockMode关闭连接和套接字,并且没有直接创建套接字连接它的方法。

    要解决这个问题,我们需要在创建套接字之后但在连接之前挂钩。这可以使用DoCreateHandle受保护的方法或OnCreateHandle事件来完成。

    最好的方法是从TTcpClient派生一个类并使用DoCreateHandle,但如果出于任何原因需要直接使用TTcpClient而不使用派生类,则可以使用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;
    

    使用方法:

    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;
    

    如前所述,Connected不适用于非阻塞套接字,因此我添加了一个新的IsConnected属性来克服此问题(仅在与ConnectWithTimeout连接时才有效)。

    ConnectWithTimeoutIsConnected都适用于阻塞套接字和非阻塞套接字。