Fórum Preciso fazer um testador de portas urgente #595068

unit UFP;

interface

uses  Winsock,
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDAC.Stan.Intf, FireDAC.Stan.Option,
  FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
  FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.FB,
  FireDAC.Phys.FBDef, FireDAC.VCLUI.Wait, Vcl.StdCtrls, FireDAC.Comp.UI,
  FireDAC.Phys.IBBase, Data.DB, FireDAC.Comp.Client, Vcl.ExtCtrls,
  IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient,
  IPPeerServer, IdTCPConnection, IdTCPClient, Datasnap.DSCommonServer,
  Datasnap.DSTCPServerTransport;

type
  TTFP = class(TForm)
    Button1: TButton;
    Mlog: TMemo;
    Button2: TButton;
    INCO: TTrayIcon;
    Edt_IP_SERVER: TEdit;
    Edt_PORTA_CNX: TEdit;

    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
function Verificação_Porta(const APort: Integer; const AAddress: string):
    Boolean;
  public
    { Public declarations }
  end;

var
  TFP: TTFP;

  Partida,Gasto:TTime;
   Retorno:string;
implementation

{$R *.dfm}
function TTFP.Verificação_Porta(const APort: integer; const AAddress: string):
    Boolean;
var
  LTcpClient: TIdTCPClient;
begin
  LTcpClient := TIdTCPClient.Create(nil);
  try
    try
      LTcpClient.Host := AAddress;      //Endereço Server
      LTcpClient.Port := APort;         //Porta para teste de Conexão
      LTcpClient.ConnectTimeout := 200; //assumir uma porta a ser fechada se não responder dentro de 200ms (algumas portas serão imediatamente rejeitadas, outras estão usando um mecanismo de "sigilo")
      LTcpClient.Connect;               //Tenta Conectar
      result := true;                   //Retorno de Porta aberta
      Retorno:='Ativo';
    except
      result := false;      Retorno:='Desativado';
    end;
  finally
    freeAndNil(LTcpClient);
  end;
end;


procedure TTFP.Button1Click(Sender: TObject);
begin
Mlog.Clear;
   Partida:=now;

   Verificação_Porta(StrToInt(Edt_PORTA_CNX.Text),Edt_IP_SERVER.Text);
   Gasto:=now-Partida;
   Mlog.Lines.Add(DateTimeToStr(now));
   Mlog.Lines.Add('Tempo Gasto :'+TimeToStr(gasto));
   Mlog.Lines.Add(Retorno);

end;

procedure TTFP.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TTFP.Button3Click(Sender: TObject);
begin
Mlog.Clear;
end;


end.