Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

sábado, 2 de junho de 2012

DELPHI - Ping com IdIcmpClient (Indy 10) - Plataformas aceitas: Win32, Win64, Android, OS X, iOS

Reações: 


// Corrigida em 14-06-2012 - Testada na mesma data


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  IdBaseComponent, IdComponent // Objeto Base Indy
  , IdRawBase, IdRawClient, IdIcmpClient, // Objeto para Ping
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    _PingOK : Boolean;
    procedure ICMPStatus(ASender: TObject; const AStatus: TIdStatus; const                 AStatusText: string);
    procedure ICMPReply(ASender: TComponent; const AReplyStatus: TReplyStatus);

    Function Ping(HostName: String): boolean;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}
procedure TForm1.ICMPReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
  try
    if AReplyStatus.BytesReceived > 0 then    
    _PingOK := True
    else
    _PingOK := False;
  except
    _PingOK := False;
  end;
end;


procedure TForm1.ICMPStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  Exit;
  try
    _PingOK := True;
  except
    _PingOK := False;
  end;
end;

Function TForm1.Ping(HostName: String): boolean;
var
 ICMP : TIdIcmpClient;
begin
try

  ICMP := TIdIcmpClient.Create(Application);
  try
   ICMP.OnStatus       := Form1.ICMPStatus;
   ICMP.OnReply        := Form1.ICMPReply;
   ICMP.Host           := HostName;
   ICMP.ReceiveTimeout := 500;
   ICMP.port           := 80;
    {$IFDEF ANDROID}
     {$DEFINE LINUX}
       ICMP.Ping;
     {$UNDEF LINUX}
   {$ELSE}
     ICMP.Ping;
   {$ENDIF}
   Sleep(1);
   Application.ProcessMessages;
   Result := _PingOK;
  except
   result := false;
  end;

finally
 FreeAndNil(ICMP);
end;

rnd;


procedure TForm1.Button1Click(Sender: TObject);
const
  Host = 'www.google.com.br';
begin
 if Ping(Host) then
 showmessage(host + ' OK')
 else
  showmessage(host + ' ERR');
end;

end.
//-------------

Nenhum comentário:

Postar um comentário

Observação: somente um membro deste blog pode postar um comentário.

Max Gehringer