Tipy a triky v Delphi, díl 180. – Indy a ping

Dnes se opět podíváme na balík Indy a jednu ze základních úloh všech síťových aplikací. Budeme zkoumat dostupnost serveru a magickým slůvkem dnešního dílu je tedy ping.

Na první pohled na záložkách komponent balíku Indy žádný ping není, což může začínajícího programátora zmást. Pokud se však trochu více zajímá o sítě, možná ho brzy zaujme komponenta IdIcmpClient, která dělá přesně to, oč nám v dnešním dílu půjde.

Nejprve si připravíme formulář naší budoucí aplikace. Budeme potřebovat v první řadě komponentu pro výpis výsledků, pročež jsem zvolil ListView ve stylu vsReport a nadefinujeme si čtyři sloupce. Do prvního bude vypisována IP adresa dotazovaného serveru, druhý sloupce obsahuje počet odeslaných bajtů, ve třetím bude hodnota TTL (Time To Live neboli zjednodušeně řečeno životnost paketu cestou mezi routery) a konečně poslední hodnota je doba odezvy serveru v milisekundách. Pochopitelně můžeme pro výpis použít i obyčejný ListBox nebo Memo.

Kromě tlačítka, které celou akci spustí, budeme ještě potřebovat dva Edity. Do prvního uživatel vloží adresu serveru, který chce "pingnout", druhá hodnota pak určuje, kolik těchto "pingů" pošleme. Tolik tedy uživatelské prostředí. Zbývá již jen poslední komponenta, kterou je zmiňovaný IdIcmpClient.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdRawBase,
  IdRawClient, IdIcmpClient;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    IdIcmpClient1: TIdIcmpClient;
    procedure IdIcmpClient1Reply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);
begin
  if AReplyStatus.MsRoundTripTime > IdIcmpClient1.ReceiveTimeout then ListView1.Items.Add.Caption := `vypršel časový limit`
  else
    begin
      ListView1.Items.BeginUpdate;
      with ListView1.Items.Add do
        begin
          Caption := AReplyStatus.FromIpAddress;
          SubItems.Add(IntToStr(AReplyStatus.BytesReceived));
          Subitems.Add(IntToStr(AReplyStatus.TimeToLive));
          if AReplyStatus.MsRoundTripTime = 0 then Subitems.Add(`<1 ms`)
                                              else Subitems.Add(IntToStr(AReplyStatus.MsRoundTripTime));
        end;
      ListView1.Items.EndUpdate;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
  Button1.Enabled := False;
  try
    IdIcmpClient1.Host := Edit1.Text;
    for i := 1 to StrToInt(Edit2.Text) do
      begin
        IdIcmpClient1.Ping;
        Application.ProcessMessages;
      end;
  finally
    Button1.Enabled := True;
  end;
end;

end.

Jak vidíte, samotný kód je pak již velmi jednoduchý. V zásadě jen použijeme funkci Ping dané komponenty, přičemž odezvou na tuto žádost je vyvolání události OnReply. V této události pak řešíme samotné zobrazování výsledků, přičemž všechny podstatné hodnoty jsou uloženy v proměnné AReplyStatus.

Zbývá ujasnit ještě dvě věci v kódu. Vidíme zde podmínku, která určuje, zda došlo k vypršení časového limitu. Tento limit je pochopitelně volitelný, pro náš příklad jsem zvolil 2 sekundy nastavením příslušné hodnoty komponenty IdIcmpClient přímo v Object Inspectoru. Tuto hodnotu si můžete samozřejmě zvolit sami, případně přidat na formulář další Edit pro vložení této hodnoty uživatelem.

Druhá věc, která působí na první pohled pozoruhodně a nelogicky, je podmínka, určující odezvu menší jak 1 ms. Na vině jsou samotné Windows, které nemají takovou rozlišovací schopnost, aby šlo získat přesnou hodnotu menší jak 1 ms. V takovém případě vrací nulu, což je pochopitelně nesmysl. Získáme-li tedy nulovou hodnotu, přesnější informace pro uživatele je taková, že doba je menší než 1 ms. Stejným způsobem problém "řeší" i samotné Windows a jejich program Ping. Nejsem si však jistý, jak se chovají serverové verze Windows, tam je třeba problém vyřešen.

A to je pro dnešek již úplně všechno. Opět máte možnost si ukázkovou aplikaci stáhnout zde.

Diskuze (5) Další článek: Překladač PC Translator pracuje s Mozillou a Firefoxem

Témata článku: , , , , , , , , , , , , ,