Exemplo monitoramento TCP Delphi - example of delphi tcp monitoring thread

MainUnit.pas

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdTCPClient, IdIOHandler, IdSSLOpenSSL, IdBaseComponent, IdComponent, 
  IdTCPConnection, IdGlobal, ExtCtrls, IdTCPServer, SyncObjs, MonitorThreads;

type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdTCPServer1: TIdTCPServer;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FClientThreadActive: Boolean;
    FServerThreadActive: Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Interval := 5000;  // Configure o intervalo desejado (em milissegundos)
  Timer1.Enabled := True;   // Habilite o timer
  FClientThreadActive := False;
  FServerThreadActive := False;

  IdTCPClient1.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdTCPClient1);
  IdTCPClient1.Host := 'localhost';
  IdTCPClient1.Port := 12345;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if not FClientThreadActive then
  begin
    FClientThreadActive := True;
    TClientMonitorThread.Create(IdTCPClient1);
  end;

  if not FServerThreadActive then
  begin
    FServerThreadActive := True;
    TServerMonitorThread.Create(IdTCPServer1);
  end;
end;

end.

MonitorThreads.pas

unit MonitorThreads;

interface

uses
  System.Classes, IdTCPClient, IdTCPServer, SyncObjs, IdSSLOpenSSL, IdIOHandler;

type
  TClientMonitorThread = class(TThread)
  private
    FClient: TIdTCPClient;
    procedure OnDisconnect(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create(AClient: TIdTCPClient);
  end;

  TServerMonitorThread = class(TThread)
  private
    FServer: TIdTCPServer;
  protected
    procedure Execute; override;
  public
    constructor Create(AServer: TIdTCPServer);
  end;

var
  TCPMutex: THandle;

implementation

function Reconnect(const Socket: TIdTCPClient): Boolean;
begin
  Result := False;
  try
    if Socket.Connected then
      Socket.Disconnect;
    Socket.Connect;
    Result := True;
  except
    on E: Exception do
    begin
      // Log de erro de conexão, se necessário
    end;
  end;
end;

{ TClientMonitorThread }

constructor TClientMonitorThread.Create(AClient: TIdTCPClient);
begin
  inherited Create(True);
  FClient := AClient;
  // Configurações adicionais
  FClient.IOHandler.AllowReconnect := True;
  FClient.IOHandler.ReconnectAttempts := 5;  // Número de tentativas de reconexão
  FClient.IOHandler.ReconnectDelay := 1000;  // Delay entre as tentativas de reconexão em milissegundos
  // Outras configurações úteis
  FClient.ConnectTimeout := 5000;  // Timeout de conexão em milissegundos
  FClient.ReadTimeout := 1000;     // Timeout de leitura em milissegundos
  FClient.OnDisconnect := OnDisconnect;  // Assign the OnDisconnect event handler
  FreeOnTerminate := True;
  Start;  // Inicia a thread explicitamente
end;

procedure TClientMonitorThread.Execute;
begin
  WaitForSingleObject(TCPMutex, INFINITE);
  try
    if not FClient.Connected then
    begin
      try
        FClient.Connect;
      except
        on E: Exception do
        begin
          // Pode logar ou tratar erro, se necessário
        end;
      end;
    end;
  finally
    ReleaseMutex(TCPMutex);
  end;
end;

procedure TClientMonitorThread.OnDisconnect(Sender: TObject);
begin
  // Se a desconexão não for causada pelo usuário, tentar reconectar agressivamente
  while not Reconnect(FClient) do
  begin
    Sleep(1000);  // Tenta reconectar a cada 1 segundo
  end;
end;

{ TServerMonitorThread }

constructor TServerMonitorThread.Create(AServer: TIdTCPServer);
begin
  inherited Create(True);
  FServer := AServer;
  FreeOnTerminate := True;
  Start;  // Inicia a thread explicitamente
end;

procedure TServerMonitorThread.Execute;
begin
  WaitForSingleObject(TCPMutex, INFINITE);
  try
    if not FServer.Active then
    begin
      try
        FServer.Active := True;
      except
        on E: Exception do
        begin
          // Pode logar ou tratar erro, se necessário
        end;
      end;
    end;
  finally
    ReleaseMutex(TCPMutex);
  end;
end;

initialization
  TCPMutex := CreateMutex(nil, False, 'Global\TCPMutexName');

finalization
  CloseHandle(TCPMutex);

end.