Preciso fazer um testador de portas urgente

Delphi

26/06/2018

Boa noite pessoal
Trabalho em uma empresa de Monitoramento e estou precisando de uma ajuda
Tenho um banco de dados com acesso de clientes(DDNS) que uso na empresa para acessar as cameras do monitoramento, porem estes clientes eu tenho que abrir um por um todos os dias para ver quem esta conectado ou não, além de ser demorado se não estiver funcionando e houver um disparo no local e não abrir as cameras ferrou.
Estou tentando montar um programa basico que ele pegue de um banco db o endereço e porta e faca um teste e me retorne sim ou não, uso apenas um tipo de porta para acesso e estou quebrando a cabeça.
trabalho com delphi a uns 5 anos este esta me deixando de cabelo em pé, fiz um a um tempo atraz mas não retornava o resultado preciso.
Exemplo: cliente: cliente250.dyndns.org portahttp: 9015 conectado:sim
o Programa exporta para *.db e importa o mesmo
Agradeço quem puder ajudar
Obs: não é um port Scanner e sim um testport
Ronaldo Gomes

Ronaldo Gomes

Curtidas 0

Melhor post

Raimundo Pereira

Raimundo Pereira

26/06/2018

Bom dia!
Tenho uma rotina que verifica apenas um servidor por vez.

Você pode adaptar.
1. Cadastre todos os seus clientes numa tabela depois realize um for.
Segue a unit do meu Projeto:

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.

GOSTEI 2

Mais Respostas

Ronaldo Gomes

Ronaldo Gomes

26/06/2018

Obrigado amigo, vou testar hj se der certo eu aviso
GOSTEI 0
Ronaldo Gomes

Ronaldo Gomes

26/06/2018

Valeu amigo, fiz umas modificações e deu certo, agradeço muito.
Agora tenho que estudar o rvmedia para abrir as cameras dos dvrs.
Muito Obrigado!!!!!
GOSTEI 0
POSTAR