Dwa w jednym czyli jak napisać komponent i wysłać pinga

Artykul ten skierowany jest raczej dla poczatkujacych programistów Delphi jezeli chodzi

o tworzenie komponentów natomiast w kwestii samego Pinga to mysle ze, Ci bardziej zaawansowani
tez skorzystaja.
Czesto na grupach dyskusyjnych ludzie zadaja pytanie:
Jak wyslac pinga z mojej aplikacji ?
Odpowiedzi z reguly dot. gotowych rozwiazan, najczesciej komponentu z pakietu ICS lub INDY.
Sa to bardzo dobre pakiety ale dlaczego nie zrobic tego samemu ?
No wlasnie, ale jak to zrobic?
Do realizacji tego zadania wybralem narzedzia jakie daje nam system Windows. System ten wyposazony jest w specjalne API (zestaw funkcji dla programistów) do realizacji pewnych danych w warstwie sieciowej platformy WIN32(nie mylic z warstwa modelu sieciowego ISO) które nazwano
IPHelper. A wiec IPHelper posiada zestaw funkcji które pozwalaja na wysylanie pakietów ICMP (czyli popularnego Pinga:)) z których skorzystamy przy tworzeniu komponentu.
(Przed rozpoczeciem zabawy z Delphi prosze sciagnac zródla komponentu z
http://zbyszek.dobak.w.interia.pl/dping.rar)

Nas interesuja nastepujace funkcje :
1.IcmpCreateFile : jest to podstawowa funkcja która tworzy nam odpowiedni uchwyt wykorzy-
stywany w pozostalych funkcjach. Od niej zawsze zaczynamy.
2.IcmpSendEcho: wysyla odpowiednio spreparowany pakiet ICMP i zwraca stosowne wyniki
3.IcmpCloseHandle: zwalnia uchwyt przydzielony przez IcmpCreateFile. Wywolujemy ja na koncu.

No dobrze, a gdzie znalezc te funkcje ?
Funkcje te eksportowane sa przez biblioteke icmp.dll i niestety nie ma deklaracji tych funkcji
w standartowych unit'ach Delphi (przynajmniej nie ma w D5 a w takiej pisze:) ). Na szczescie
mamy dostep do msdn (msdn.microsoft.com) i tam mozna znalezc pelne deklaracje owych funkcji i
zwiazanych z nimi struktur danych. Po przestudiowaniu dokumentacji tworzymy odpowiednie naglówki funkcji i typy danych.

Potrzebne beda nam dwie struktury o nastepujacej definicji :

PIPOptionIinfoormation=^TIPOptionIinfoormation;
TIPOptionIinfoormation=packed record
TTL:byte;
Tos:byte;
Flags:byte;
OptionsSize:byte;
OptionsData:^byte;
end;

PICMPEchoReply=^TICMPEchoReply;
TICMPEchoReply=packed record
Address:cardinal;
Status:ULONG;
RoundTripTime:ULONG;
DataSize:Word;
Reserved:Word;
Data:pointer;
Options:TIPOptionIinfoormation;
end;

i trzy funkcje które dolaczymy do naszego projektu statycznie przy pomocy derektywy "external"

function IcmpCreateFile:THandle;stdcall;external 'icmp.dll';

function IcmpCloseHandle(IcmpHandle:THandle):BOOL;stdcall;external 'icmp.dll';

function IcmpSendEcho(IcmpHandle:THandle;DestinationAddress:longint;
RequestData:pointer;RequestSize:Word;
RequestOptions:PIPOptionIinfoormation;
ReplyBuffer:pointer;ReplySize:DWORD;
Timeout:DWORD):DWORD;stdcall;external 'icmp.dll';

function IcmpParseReplies(ReplyBuffer:pointer;ReplySize:DWORD):DWORD;
stdcall;external 'icmp.dll';

No to mamy wszystko co potrzeba aby pingowac. Zabierzmy sie teraz za budowe komponentu.

Z menu wybieramy Component->New Component i wypelniamy odpowiednio pola okienka dialogowego.
Dla Ancestor Type podajemy "TComponent" a dla Class Name nazwe naszej klasy dla komponentu, niech bedzie TDPing, w polu Palette Page podajemy nazwe zakladki w palecie komponentów w której nasze cacko ma zostac umiejscowione. Po tych operacjach wciskamy OK i Delphi generuje nam szablonowy kod komponentu. Nie bede omawial poszczególnych elementów kodu poniewaz artykul rozrósl by sie do dosc sporych rozmiarów.
Zajmiemy sie teraz wypelnianiem wygenerowanego kodu odpowienimi danymi ;).
W sekcji uses dodajemy dodatkowo dwa moduly winsock i math a nastepnie wrzucamy do czesci interface modulu definicje odpowiednich typów i nasze funkcje z icmp.dll co widac na ponizszym
obrazku :).

unit DPing;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Winsock,Math;

type
  PIPOptionIinfoormation=^TIPOptionIinfoormation;
  //struktura zawierajaca opcje dodatkowe dla IcmpSendEcho
  //szczególowe informacje w msdn
  TIPOptionIinfoormation=packed record
    TTL:byte;
    Tos:byte;
    Flags:byte;
    OptionsSize:byte;
    OptionsData:^byte;
  end;

  PICMPEchoReply=^TICMPEchoReply;
  //struktura wypalniana przez IcmpSendEcho
  //szczególowe informacje w msdn
  TICMPEchoReply=packed record
    Address:cardinal;
    Status:ULONG;
    RoundTripTime:ULONG;
    DataSize:Word;
    Reserved:Word;
    Data:pointer;
    Options:TIPOptionIinfoormation;
   end;

  //rsLives:host odpowiada
  //rsdead:host nie odpowiada
  TReplyStatus=(rsLives,rsDead);
  //typ okreslajacy zdarzenie wywolywane po realizacji Ping
  TReplyEvent=procedure (Sender:TObject;ReplyStatus:TReplyStatus;ReplyTime:integer) of object;
  TDPing = class(TComponent)
  private
    FWSAData: TWSAData;
    FHost: string;
    FTimeOut: integer;
    FTTL: integer;
    FPacketSize: integer;
    FOnReply: TReplyEvent;
    FHostIp:string;
  protected
    procedure Reply(ReplyStatus:TReplyStatus;ReplyTime:integer);virtual;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure Ping;
    //adres ip hosta
    property HostIp:string read FHostIp;
  published
    //adres hosta do którego bedziemy wysylac pakiet ICMP
    property Host:string read FHost write FHost;
    //max. czas oczekiwania na odpowiedz hosta
    property TimeOut:integer read FTimeOut write FTimeOut;
    //rozmiar pakietu wysylanego do hosta
    property PacketSize:integer read FPacketSize write FPacketSize;
    //czas zycia pakietu
    property TTL:integer read FTTL write FTTL;
    //zdarzenie wywolywane po realizacji IcmpSendEcho
    property OnReply:TReplyEvent read FOnReply write FOnReply;
  end;

function IcmpCreateFile:THandle;stdcall;external 'icmp.dll';
  
function IcmpCloseHandle(IcmpHandle:THandle):BOOL;stdcall;external 'icmp.dll';
  
function IcmpSendEcho(IcmpHandle:THandle;DestinationAddress:longint;
                       RequestData:pointer;RequestSize:Word;
                       RequestOptions:PIPOptionIinfoormation;
                       ReplyBuffer:pointer;ReplySize:DWORD;
                       Timeout:DWORD):DWORD;stdcall;external 'icmp.dll';

function IcmpParseReplies(ReplyBuffer:pointer;ReplySize:DWORD):DWORD;
                            stdcall;external 'icmp.dll';

Jak widac nasz komponent zawiera szereg skladników.
Nie bede omawial calej deklaracji w sensie Object Pascala a skupie sie jedynie na elementach które moga byc nie znane poczatkujacemu budowniczemu komponentów.
Co nowego mozna zauwazyc z czym sie nie ma do czynienia przy projektowaniu standartowej
aplikacji Delphi ?
No..., oczywiscie slowo kluczowe property. Property to nic innego jak wlasciwosc. To jest to
co widzimy na zakladce "properties" inspektora obiektów. To czy nasza wlasciwosc bedzie widoczna w inspektorze obiektów czy nie, decyduje umiejscowienie jej w odpowiedniej sekcji w klasie. Aby byla widoczna musimy ja umiescic w sekcji published.
Kazda z wlasciwosci(property) posiada skojarzone z nia pole prywatne w którym tak de'facto przechowywana jest wartosc wlasciwosci.
np:

property TimeOut:integer read FtimeOut write TimeOut;

Po slowach read/write umieszczamy nazwy pól z których czytamy/zapisujemy wartosci wlasciwosci.
Tak na prawde to po read/write moga wystapic równiez nazwy metod(procedur, funkcji) dostepowych przez które czytamy lub zapisujemy dana wlasciwosc, ale o tym nastepnym razem ;).
Spostrzegawczy czytelnik zauwazy ze przy wlasciwosciach we wszystkich przypadkach mamy read i
write a w jednym przypadku "HostIp" stoi tylko read.Wlasnie przy pomocy takiej konstrukcji tworzy sie wlasciwosc tylko do odczytu.

Na wyjasnienie zasluguje równiez konstructor i destruktor klasy. Konstruktor krótko mówiac sluzy do tworzenia obiektów danej klasy a destruktor a destruktor do niszczenia.
Przyjrzyjmy sie naszemu konstruktorowi

constructor TDPing.Create(AOwner: TComponent);
var err:integer;
begin
  //wywolujemy konstruktor przodka
  inherited;
  //ustalamy rozmiar pakietu
  FPacketSize:=56;
  //ustalamy TTL
  FTTL:=64;
  //ustalamy maksymalny czas oczekiwania na odpowiedz na 2000ms
  FTimeOut:=4000;
  //spawdz czy komponent nie jest w fazie projektowania aplikacji
  if not (csDesigning in ComponentState) then
  begin
    //incjujemy biblioteke Winsock
    err:=WSAStartup(MAKEWORD(1,1),FWSAData);
    //sprawdzamy czy poprawnie zainiciowano winsock'a
    if err>0 then raise Exception.Create(SysErrorMessage(WSAGetLastError));
  end;
end;

Szczególna uwage nalezy zwrócic na slowo inhertited które wywoluje na potrzeby naszej klasy
konstruktor klasy po której dziedziczymy (w tym przypadku TComponent). Nalezy pamietac aby
zawsze na poczatku definicji naszego konstruktora wywolywac konstruktor przodka.
pozostala czesc kodu konstruktora to inicjowanie wlasciwosci wartosciami domyslnymi oraz
zainciowanie biblioteki Winsock z której bedziemy korzystac w naszym komponencie.

Destruktor naszego komponentu wyglada bardziej ubogo i ogranicza sie jedynie do zwolnienia
biblioteki winsock

destructor TDPing.Destroy;
begin
  //zwalniamy biblioteke winsoc'k
  WSACleanUp;
  //wywolujemy destruktor przodka
  inherited;
end;

Skupmy sie teraz na sednie sprawy czyli procedurze Ping.

procedure TDPing.Ping;
var
  //uchwyt zwarcany przez IcmpCreateFile
  hIcmp:THandle;
  //ciag znaków który zostanie wyslany do hosta
  DataStr:string;
  //wskaznik do struktury w której odczytamy wynik dzialania IcmpSendEcho
  EchoData:PICMPEchoReply;
  //wskaznik ten okresla bufor w którym odbierzemy dane z hosta
  //jest on czescia struktury TICMPEchoReply
  ReplyData:pointer;
  //rozmiar bufora na dane wyslane do hosta
  //powiekszone o wlasciwosc PacketSize komponentu
  BufferSize:integer;
  //wskaznik do danych zadania wysylanego do hosta
  //dane zawieraja równiez ciag DataStr
  RequestData:pointer;
  Option:TIPOptionIinfoormation;
  //wynik funkcji IcmpSendEcho
  IcmpResult:DWORD;
  //adres ip hosta
  addr:longint;
  //zmienna w której przechowujemy wyniki dzialania GetHostByName
  AddrResolve:PHostEnt;
begin
  //zamien adres/nazwe hosta na wlasciwa postac binarna(network order)
  addr:=inet_addr(PChar(FHost));
  //sprwdz czy dostalismy poprawny adres
  if addr=longint(INADDR_NONE) then
  begin
    //próbujemy rozwiazac adres przy pomocy GetHostByName
    //jest to niezbedne w przypadku gdy adres hosta podany
    //jest jako nazwa hosta a anie jako xxx.xxx.xxx.xxx
     AddrResolve:=GetHostByName(PChar(FHost));
     //jezeli nie mozemy okreslic adresu
     //wygeneruj wyjatek i wyjdz z proceduty
     if AddrResolve=nil then
     begin
       raise Exception.Create(SysErrorMessage(WSAGetLastError));
       Exit;
     end;
      //wydobywamy adres hosta ze struktury hostent
     Addr:=LongInt(PLongInt(AddrResolve^.h_addr_list^)^);
   end;
   //zamien adres hosta na notacje xxx.xxx.xxx.xxx
   FHostIp:=StrPas(inet_ntoa(TInAddr(Addr)));
   //utwórz uchwyt do obslugi icmp
  hIcmp:=IcmpCreateFile;
  //sprawdz czy dostalismy poprawny uchwyt
  if hIcmp<>0 then
  begin
    try
      //okreslamy wielkosc ramki
      BufferSize:=SizeOf(TICMPEchoReply)+FPacketSize;
      //ustalamy dane w postaci tekstu
      DataStr:='Komunikat wyslany do hosta z naszego komputera :)';
      //rezerwujemy pamiec
      GetMem(EchoData,BufferSize);
      GetMem(ReplyData,FPacketSize);
      GetMem(RequestData,max(FPacketSize,Length(DataStr)));
      //wypelniamy bufor pewnymi danymi
      FillChar(RequestData^,FPacketSize,$15);
      //wypelniamy bufor danymi z DataStr
      move(DataStr[1],RequestData^,Length(DataStr));
      //czyscimy pamiec
      ZeroMemory(@Option,SizeOf(TIPOptionIinfoormation));
      Option.TTL:=FTTL;
      EchoData^.Data:=ReplyData;
      IcmpResult:=IcmpSendEcho(hIcmp,Addr,RequestData,max(FPacketSize,Length(DataStr)),      
                               @Option,EchoData,BufferSize,FTimeOut);
      //wywolaj procedure obslugi zdarzenia OnReply
      if IcmpResult>0 then Reply(rsLives,max(EchoData^.RoundTripTime,1)) else
      Reply(rsDead,0);
    finally
      //zwolnij pamiec
      FreeMem(EchoData);
      FreeMem(ReplyData);
      FreeMem(RequestData);
    end;
    IcmpCloseHandle(hIcmp);
  end else raise Exception.Create(SysErrorMessage(GetLastError));
end;

Jak widac kod jest bogato skomentowany, ale jedna sprawa z punktu widzenia komponentu wymaga omówienia, mianowicie procedura Reply. Co ona tak naprawde robi ? Spójrzmy do ciala procedury

procedure TDPing.Reply(ReplyStatus: TReplyStatus; ReplyTime: integer);
begin
  if Assigned(FOnReply) then FOnReply(Self,ReplyStatus,ReplyTime);
end;

Bardzo proste prawda ? Po prostu sprawdzamy czy zostala przypisana procedura obslugi zdarzenia
jezeli tak to ja wywolujemy. Jest to typowa konstrukcja i warto ja zapamietac.
Na koniec powiem jeszcze jak zainstalowac komponent. Z menu wybieramy Component->Install Component w polu unit Name podajemy nazwe naszego modulu i OK. po tej operacji komponent powinien bys widoczny w palecie komponentów.
No cóz na tym chyba zakonczymy. Zdaje sobie sprawe ze to co napisalem to jest tylko
baaaaaaaaardzo mala kropelka w morzu tak obszernego tamatu jakim jest tworzenie komponentów.
Warto jednak blizej sie przyjrzec zródlom tego prostego a jakze przydatnego komponentu w kontekscie Object Pascala jak i WinApi.

ps.

Jest to pierwszy art i nie wiem jak z formatowaniem tekstu wyjdzie :))))

Pozdrawiam

Zbyszek Dobak;zibi;zibol ;)