Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Ping

Posted on 2003-03-20
6
Medium Priority
?
1,058 Views
Last Modified: 2012-08-13
Hello Friends!!!

A question,
How can I make a ping in the Delphi ?????

Thanks!!!


Rafael Schardosin
Porto Alegre - Brazil
0
Comment
Question by:schardosin
4 Comments
 

Expert Comment

by:use_the_source
ID: 8175647
Have a look at the ICS by F. Piette : it contains a TPing component. It's using ICMP.DLL though, which is depreciated by Microsoft, at least it was a couple of years ago as support for this dll 'could dissapear in the near future'.  But looks like ICMP.DLL is holding on : MS's own ping.exe is using it.
Another way is using by using raw socket, but that involves needing Administrator rights on a standard installation.  I made a component once that used raw sockets for a ping, but don't have the source around right now.  If I don't forget it, I'll try to have it around next week or so.

Hope this helps.
0
 

Accepted Solution

by:
Imagine earned 100 total points
ID: 8175925
Hi,

You can do that with indy.

Use the IdIcmpClient1 to ping to that pc like this:

[code]

procedure TForm4.Timer1Timer(Sender: TObject);
begin
 application.ProcessMessages;
 IdIcmpClient1.OnReply := IdIcmpClient1Reply;
 IdIcmpClient1.ReceiveTimeout := 25;
 IdIcmpClient1.Host := ('192.168.0.1');
 IdIcmpClient1.Ping;
end;

procedure TForm4.IdIcmpClient1Reply(ASender: TComponent;
 const AReplyStatus: TReplyStatus);
begin
 if (aReplyStatus.BytesReceived > 0) then begin
   application.ProcessMessages;
   {let the user know that the computer is availeble}
 end else begin
   application.ProcessMessages;
   {let the user know that the computer is NOT availeble}
 end
end;

[/code]

Indy is freeware and can be downloaded from:
http://www.indyproject.org/
0
 
LVL 3

Assisted Solution

by:lopem
lopem earned 100 total points
ID: 8176856
I wrote a simple program to ping a public machine so I know if my connection is alive. I used the ICS routines, the best around here... This is the code... You can take only the ping part, of course...

best wishes
Manuel Lopez (lopem)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Ping, StdCtrls, Spin, MPlayer, ExtCtrls, YRChrono, Gauges,
  ImgList, NotifyIcon, LedAuto;

type
  TForm1 = class(TForm)
    Ping1: TPing;
    Edit1: TEdit;
    Label1: TLabel;
    Timer1: TTimer;
    MediaPlayer1: TMediaPlayer;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    Label3: TLabel;
    Crono1: TYRChronometre;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Memo1: TMemo;
    Gauge1: TGauge;
    Timer2: TTimer;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    NotifyIcon1: TNotifyIcon;
    ImageList1: TImageList;
    LedAuto1: TLedAuto;
    LedAuto2: TLedAuto;
    procedure Ping1DnsLookupDone(Sender: TObject; Error: Word);
    procedure Ping1EchoReply(Sender, Icmp: TObject; Error: Integer);
    procedure Ping1EchoRequest(Sender, Icmp: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1     : TForm1;
  Errores   : integer;
  StatusAct,
  StatusAnt : boolean;
  Tiempo    : string;
  FileName  : string;
  Contador  : integer;

implementation

{$R *.dfm}

procedure MensajeMemo(letrero : string);
//pone un mensaje en el campo Memo...
begin
  Form1.Memo1.Lines.Add(Letrero);
end;

procedure Hora;
//lee la hora y si los minutos son 0, 15, 30 o 45
//escribe en la bitacora el status del sistema
var
    T1      : string;
begin
  T1 := Form1.Label5.Caption;
//  Form1.Label6.Caption := inttostr(Contador);
  if Contador > 15 then
  begin
    Contador := 0;
    MensajeMemo('Tiempo efectivo SIN conexisn: '+ T1);
    MensajeMemo('-------');
    Form1.Memo1.Lines.SaveToFile(FileName);
  end;
end;

procedure Mensaje(letrero: string);
//pone un mensaje en la zona de mensajes
begin
  Form1.Label4.Caption := '                                                 ';
  Form1.Label4.Caption := Letrero;
end;

procedure TForm1.Ping1DnsLookupDone(Sender: TObject; Error: Word);
var
   R : integer;
   A : TDateTime;
   T1: string;
begin
  if Error <> 0 then
  begin
    Mensaje('Host: "' + Edit1.Text + '" '+ 'desconocido...');
    Errores := -1;
  end;
  if Errores = 0 then Mensaje('Host: "' + Edit1.Text + ' "' +' tiene el siguiente IP: ' + Ping1.DnsResult);
  Ping1.Address := Ping1.DnsResult;
  R := Ping1.Ping;
  A := Now;
  if R = 1 then
  begin
    Errores := 0;
    StatusAct := TRUE;
    Mensaje('Cablemsdem CONECTADO');
    LedAuto1.LedStatus := lsOn;
    LedAuto2.LedStatus := lsOff;
    Crono1.Stop;
    if StatusAct <> StatusAnt then
    begin
      MediaPlayer1.FileName := 'aplausos.wav';
      MediaPlayer1.Open;
      MediaPlayer1.Play;
      MensajeMemo('Conectado: '+ DateTimeToStr(A));
      MensajeMemo('-----');
      T1 := Crono1.Time2Str(Crono1.TotalTimeElapsed);
      MensajeMemo('Tiempo efectivo SIN conexisn: '+ T1);
      MensajeMemo('-------');
      Memo1.Lines.SaveToFile(FileName);
    end;
    StatusAnt := StatusAct;
    Gauge1.MinValue := 0;
    Gauge1.MaxValue := Timer1.Interval;
    Gauge1.Progress := 0;
  end
  else
  begin
    Errores := -1;
    StatusAct := FALSE;
    Mensaje('CableMsdem DESCONECTADO');
    LedAuto1.LedStatus := lsOff;
    LedAuto2.LedStatus := lsOn;
    Crono1.Start;
    if StatusAct <> StatusAnt then
    begin
      MediaPlayer1.FileName := 'oops.wav';
      MediaPlayer1.Open;
      MediaPlayer1.Play;
      MensajeMemo('Desconectado: '+ DateTimeToStr(A));
      MensajeMemo('-----');
      T1 := Crono1.Time2Str(Crono1.TotalTimeElapsed);
      MensajeMemo('Tiempo efectivo SIN conexisn: '+ T1);
      MensajeMemo('-------');
      Memo1.Lines.SaveToFile(FileName);
    end;
    StatusAnt := StatusAct;
    Gauge1.MinValue := 0;
    Gauge1.MaxValue := Timer1.Interval;
    Gauge1.Progress := 0;
  end;
  Label5.Caption := Crono1.Time2Str(Crono1.TotalTimeElapsed);
end;

procedure TForm1.Ping1EchoReply(Sender, Icmp: TObject; Error: Integer);
begin
  if Error = 0 then
    Mensaje('Error al hacer ping al host: (' + Ping1.HostIP + '): ' + Ping1.ErrorString)
  else
  begin
(*    if (Ping1.Reply.RTT > MaxPingTime.Value) then  // Ping Times Exceed Max
      Mensaje('Recibidos ' + IntToStr(Ping1.Reply.DataSize) +
                             ' bytes desde ' + Ping1.HostIP +
                         ' en ' + IntToStr(Ping1.Reply.RTT) + ' msegs')
    else
      Mensaje('Recibidos ' + IntToStr(Ping1.Reply.DataSize) +
                             ' bytes desde ' + Ping1.HostIP +
                         ' en ' + IntToStr(Ping1.Reply.RTT) + ' msegs');
*)  end;
end;

procedure TForm1.Ping1EchoRequest(Sender, Icmp: TObject);
begin
  Mensaje('Mandando ' + IntToStr(Ping1.Size) + ' bytes a ' +
           Ping1.HostName + ' (' + Ping1.HostIP + ')');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //si no hay nombre de servidor para hacer ping, poner por default yahoo
  //asm se evita un error de rango cuando no hay nombre
  Mensaje('Haciendo ping a '+ trim(Edit1.Text));
  Ping1.DnsLookup(trim(Edit1.Text));
  Timer1.Interval := 60000;
  Contador := Contador + 1;
  Hora;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  Mensaje('Cambiando tiempo de muestreo a '+ inttostr(SpinEdit1.Value)+' minuto.');
  Timer1.Interval := SpinEdit1.Value * 60 * 1000;
  Gauge1.MinValue := 0;
  Gauge1.MaxValue := Timer1.Interval;
  Gauge1.Progress := 0;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  Timer1.Interval := 60000;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
   Ahora : TDateTime;
   i     : integer;
begin
  if Edit1.Text = '' then Edit1.Text := 'www.yahoo.com';
  Contador := 0;
  Ahora := Now;
  FileName := DatetoStr(Ahora) + '.log';
  for i := 1 to length(FileName) do
    if FileName[i] = '/' then FileName[i] := '_';
  LedAuto1.LedStatus := lsOn;
  LedAuto2.LedStatus := lsOff;
  MensajeMemo('Bitacora creada: '+ DateTimeToStr(Ahora));
  MensajeMemo(' ');
  MensajeMemo('-----------');
  MensajeMemo(' ');
  Memo1.Lines.SaveToFile(FileName);
  Errores := 0;
  StatusAct := TRUE; //conectado supuestamente al iniciar
  StatusAnt := FALSE; //desconectado inicialmente
  Crono1.Reset;
  Label5.Caption := Crono1.Time2Str(Crono1.TotalTimeElapsed);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
   T1 : string;
begin
  Gauge1.Progress := Gauge1.Progress + 1000;
  Label5.Caption := Crono1.Time2Str(Crono1.TotalTimeElapsed);
  T1 := Label5.Caption;
  Application.ProcessMessages;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
   T1 : string;
begin
  T1 := Label5.Caption;
  Timer1.Enabled := FALSE;
  Timer2.Enabled := FALSE;
  MensajeMemo('Tiempo efectivo SIN conexisn: '+ T1);
  MensajeMemo('-------');
  Form1.Memo1.Lines.SaveToFile(FileName);
  Application.Terminate;
end;

end.





0
 

Expert Comment

by:CleanupPing
ID: 9316652
schardosin:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
EXPERTS:
Post your closing recommendations!  No comment means you don't care.
0

Featured Post

[Webinar] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
This is an update to some code that someone else posted on Experts Exchange. It is an alternate approach, I think a little easier to use, & makes sure that things like the Task Bar will update.
Integration Management Part 2
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Suggested Courses
Course of the Month15 days, 23 hours left to enroll

580 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question