断开TIdTcpServer OnConnect上的未知连接

时间:2019-10-23 20:56:32

标签: delphi

我有问题。我创建了TIdTCPServer,但是我需要防止虚假/未知的连接。

我尝试过:

procedure Wait(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;

procedure CheckCon(Con: Pointer);
begin
  Wait(5000);

  if TClient(Con).HWID = '' then TClient(Con).Connection.Disconnect;
  EndThread(0);
end;

constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
var
  ThreadId : Cardinal;
begin
  inherited Create(AConnection, AYarn, AList);

  FCriticalSection  := TCriticalSection.Create;
  Queue             := TIdThreadSafeStringList.Create;

  BeginThread(nil, 0, @CheckCon, Self, 0, ThreadId);
end;

OnConnect事件代码:

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Conexao : TClient;
  Retorno : TArray<String>;
  Query   : TFDQuery;
  Libera  : Boolean;
  IPEX    : Boolean;
begin
  Libera  := True;
  IPEX    := True;
  Conexao := TClient(AContext);
  Retorno := AContext.Connection.IOHandler.ReadLn.Split(['#']);

  if Length(Retorno) = 0 then
  begin
    AContext.Connection.Disconnect;
    Exit;
  end;

  Conexao.IP          := AContext.Connection.Socket.Binding.PeerIP;
  Conexao.HWID        := Retorno[1];
  Conexao.Connected   := Now;
  Conexao.Ping        := Ticks;

  ClientStateUpdated(Conexao, RetornaTraducao(40));

TThread.Queue(nil,
              procedure
              begin
                Memo2.Lines.Add(Format(RetornaTraducao(36), [TimeToStr(Now), Conexao.IP, Conexao.HWID]));
              end);
end;

如果我测试创建少量的未知客户端,则效果很好,但是如果我用很多连接进行泛洪,则应用程序将崩溃。我需要这样的操作来防止TIdTCPServer中的未知连接。

我尝试致电

Memo2.Lines.Add(Format('[%s]', [AContext.Connection.IOHandler.ReadLn]));
IdTCPServer1Connect

确定连接是否是我的应用程序,但是如果客户端仅连接并且不发送任何东西,则该行将不执行。

1 个答案:

答案 0 :(得分:1)

完全不需要在TClient的构造函数中启动工作线程(TClient对象已经在服务器创建的线程中运行)。您可以简单地在ReadLn()调用本身上设置5秒钟的超时,并完成此操作。

此外,TIdTCPServer是一个多线程组件,它的事件是在辅助线程的上下文中触发的,因此必须通过与UI线程同步来访问Memo2之类的UI控件,否则将产生不良后果发生。

尝试更多类似的方法:

constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);

  FCriticalSection  := TCriticalSection.Create;
  Queue             := TIdThreadSafeStringList.Create;
end;

...

// code adapted from my reply to your previous question:
//
// https://stackoverflow.com/a/58479489/65863
//
// tweak as needed...
//
procedure TForm1.ClientStateUpdated(Client: TClient; const Msg: string);
var
  IP, HWID: string;
begin
  IP := Client.IP;
  HWID := Client.HWID;

  TThread.Queue(nil,
    procedure
    begin
      Memo2.Lines.Add(Format(RetornaTraducao(36), [TimeToStr(Now), IP, HWID, Msg]));
    end
  );
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Conexao : TClient;
  Retorno : TArray<String>;
begin
  Conexao := TClient(AContext);
  Retorno := AContext.Connection.IOHandler.ReadLn(LF, 5000).Split(['#']);

  if (Length(Retorno) < 2) or (Retorno[1] = '') then
  begin
    AContext.Connection.Disconnect;
    Exit;
  end;

  Conexao.IP          := AContext.Binding.PeerIP;
  Conexao.HWID        := Retorno[1];
  Conexao.Connected   := Now;
  Conexao.Ping        := Ticks;

  ClientStateUpdated(Conexao, RetornaTraducao(40){'connect'});
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Conexao : TClient;
begin
  Conexao := TClient(AContext);

  if Conexao.Connected <> 0 then
    ClientStateUpdated(Conexao, RetornaTraducao(...){'disconnect'});
end;