如何使用TIdTCPServer断开非活动客户端?

时间:2016-11-02 07:22:07

标签: delphi indy indy10 delphi-xe8

我正在尝试断开连接到TIdTCPServer的非活动客户端,无论这些客户端是否与Internet断开连接,或者是否处于非活动状态。

我尝试在OnConnect事件中设置超时,如下所示:

procedure TservForm.TcpServerConnect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.ReadTimeout := 26000;
  AContext.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDTIMEO, 15000);
end; 

但是在客户端连接丢失后似乎没有触发断开连接。

我尝试使用SetKeepAliveValues(),但是将非活动客户端断开连接需要花费太多时间。

是否有更有用的方法来断开非活动客户端?因此,如果客户端没有收到或发送任何内容,例如在30秒内,服务器将断开它?

执行事件

procedure TservForm.TcpServerExecute(AContext: TIdContext);
var
  Connection: TConnection;
  cmd: String;
  Cache, OutboundCmds: TStringList;
  MS: TMemoryStream;
  I: integer;
  S: String;
begin
  Connection := AContext as TConnection;

  // check for pending outbound commands...
  OutboundCmds := nil;
  try
    Cache := Connection.OutboundCache.Lock;
    try
      if Cache.Count > 0 then
      begin
        OutboundCmds := TStringList.Create;
        OutboundCmds.Assign(Cache);
        Cache.Clear;
      end;
    finally
      Connection.OutboundCache.Unlock;
    end;

    if OutboundCmds <> nil then
    begin
      for I := 0 to OutboundCmds.Count - 1 do
      begin
        AContext.Connection.IOHandler.Writeln(OutboundCmds.Strings[I],
          IndyTextEncoding_UTF8);
        MS := TMemoryStream(OutboundCmds.Objects[I]);
        if MS <> nil then
        begin
          AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
          AContext.Connection.IOHandler.LargeStream := true;
          AContext.Connection.IOHandler.Write(MS, 0, true);
        end;
      end;
    end;
  finally
    if OutboundCmds <> nil then
    begin
      for I := 0 to OutboundCmds.Count - 1 do
        OutboundCmds.Objects[I].Free;
    end;
    OutboundCmds.Free;
  end;

  // check for a pending inbound command...
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin
    Exit;
    end;
  end;

  cmd := AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8);

  ...............
  ...............

1 个答案:

答案 0 :(得分:2)

客户端没有断开连接,因为在空闲时间没有到达ReadLn(),因此ReadTimeout没有效果,如果你没有发送大量命令,那么套接字缓冲区不是填写所以SO_SNDTIMEO也没有效果。

由于您已经在进行一些手动超时处理,因此您可以对其进行扩展以处理空闲超时,例如:

type
  TConnection = class(TIdServerContext)
    ...
  public
    LastSendRecv: LongWord;
    ...
  end;

...

procedure TservForm.TcpServerConnect(AContext: TIdContext);
var
  Connection: TConnection;
begin
  Connection := AContext as TConnection;
  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
  AContext.Connection.IOHandler.LargeStream := True;
  AContext.Connection.IOHandler.ReadTimeout := 30000;
  AContext.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDTIMEO, 15000);
  Connection.LastSendRecv := Ticks;
end; 

procedure TservForm.TcpServerExecute(AContext: TIdContext);
var
  Connection: TConnection;
  cmd: String;
  Cache, OutboundCmds: TStringList;
  MS: TMemoryStream;
  I: integer;
  S: String;
begin
  Connection := AContext as TConnection;

  // check for pending outbound commands...
  OutboundCmds := nil;
  try
    Cache := Connection.OutboundCache.Lock;
    try
      if Cache.Count > 0 then
      begin
        OutboundCmds := TStringList.Create;
        OutboundCmds.Assign(Cache);
        Cache.Clear;
      end;
    finally
      Connection.OutboundCache.Unlock;
    end;

    if OutboundCmds <> nil then
    begin
      for I := 0 to OutboundCmds.Count - 1 do
      begin
        AContext.Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
        MS := TMemoryStream(OutboundCmds.Objects[I]);
        if MS <> nil then               
          AContext.Connection.IOHandler.Write(MS, 0, true);    
      end;
      Connection.LastSendRecv := Ticks;
    end;
  finally
    if OutboundCmds <> nil then
    begin
      for I := 0 to OutboundCmds.Count - 1 do
        OutboundCmds.Objects[I].Free;
    end;
    OutboundCmds.Free;
  end;

  // check for a pending inbound command...
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin
      if GetTickDiff(Connection.LastSendRecv, Ticks) >= 30000 then
        AContext.Connection.Disconnect;
      Exit;
    end;
  end;

  cmd := AContext.Connection.Socket.ReadLn;    
  Connection.LastSendRecv := Ticks;

  ...
end;
相关问题