Пінгуем (Ping) під Delphi

Протокол Ping призначений для тестування комп'ютерних сполук у
Інтернеті шляхом посилки через протокол Internet Protocol (IP) за обределенному
адресу повідомлення та очікування від нього відповіді.

ICMP – Internet Control Message Protocol. ICMP служить для
передачі повідомлень про помилки а так само керуючих повідомлень. ICMP-Тест
може показати наскільки швидко проходить інформація між двома вузлами в
Інтернеті.


  1. Запускаємо Delphi;
  2. У Новому проекті додаємо у форму Tbutton, Tedit і Tmemo;
  3. Вставляємо "winsock";
  4. оголошуємо структурку для IP-заголовка:
type IPINFO = record
Ttl : char;
Tos : char;
IPFlags : char;
OptSize : char;
Options : ^char;
end;

5. оголошуємо структурку для зберігання ICMP пакету:

type  ICMPECHO = record
Source : longint;
Status : longint;
RTTime : longint;
DataSize : Shortint;
Reserved : Shortint;
pData : ^variant;
i_ipinfo : IPINFO;
end;

6. Оголошуємо функції та процедури, які ми будемо викликати з ICMP.DLL

TIcmpCreateFile =
function():integer;{$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle =
procedure (var handle: integer); {$ IFDEF WIN32} stdcall; {$ ENDIF}
TIcmpSendEcho =
function(var handle:integer; endereco:DWORD; buffer:variant;
tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD;
tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}

7. У Tbutton в подію Onclick вставляємо наступний код:

procedure TForm1.Button1Click(Sender: TObject);
var
wsadt : wsadata;
icmp :icmpecho;
HNDicmp : integer;
hndFile :integer;
Host :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
x :integer;

IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;

begin
if (edit1.Text = “”) then begin
Application.MessageBox(“Enter a HostName ro a IP Adress”,
“Error”, MB_OK);
exit;
end;
HNDicmp := LoadLibrary(“ICMP.DLL”);
if (HNDicmp <> 0) then begin
@IcmpCreateFile := GetProcAddress(HNDicmp,”IcmpCreateFile”);
@IcmpCloseHandle := GetProcAddress(HNDicmp,”IcmpCloseHandle”);
@IcmpSendEcho := GetProcAddress(HNDicmp,”IcmpSendEcho”);
if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or
(@IcmpSendEcho=nil) then begin
Application.MessageBox ("Error getting ICMP Adress", "Error", MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);

if (Retorno <> 0) then begin
Application.MessageBox ("Can? T Load WinSockets", "WSAStartup", MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));
if (Destino.S_addr = 0) then begin
Host := GetHostbyName(PChar(Edit1.text));
end
else begin
Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
end;

if (host = nil) then begin
Application.MessageBox(“Host not found”,”Error”, MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
exit;
end;
memo1.Lines.Add(“Pinging ” + Edit1.text);

Endereco := @Host.h_addr_list;

HNDFile := IcmpCreateFile();
for x:= 0 to 4 do begin
Ip.Ttl := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(0);
Ip.Options := nil;

dwRetorno := IcmpSendEcho(
HNDFile,
Endereco^,
null,
0,
Ip,
Icmp,
sizeof(Icmp),
DWORD(5000));
Destino.S_addr := icmp.source;
Memo1.Lines.Add(“Ping ” + Edit1.text);
end;

IcmpCLoseHandle(HNDFile);
FreeLibrary(HNDicmp);
WSACleanup();
end;


У даного прикладу є один недолік – програма не сприйме доменне ім'я,
тільки IP-адресу. Для користувачів NT не використовуйте функцію IcmpCloseHandle.
Це все …..

Ну і в кінці повний вихідний код прикладу:

unit Unit1; 

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
winsock, StdCtrls;

type
IPINFO = record
Ttl :char;
Tos :char;
IPFlags :char;
OptSize :char;
Options :^char;
end;

type
ICMPECHO = record
Source :longint;
Status :longint;
RTTime :longint;
DataSize:Shortint;
Reserved:Shortint;
pData :^variant;
i_ipinfo:IPINFO;
end;

TIcmpCreateFile =
function():integer; {$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle =
procedure (var handle: integer); {$ IFDEF WIN32} stdcall; {$ ENDIF}
TIcmpSendEcho =
function(var handle:integer; endereco:DWORD; buffer:variant;
tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD;
tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public

end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
wsadt : wsadata;
icmp :icmpecho;
HNDicmp : integer;
hndFile :integer;
Host :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
x :integer;

IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;

begin
if (edit1.Text = “”) then begin
Application.MessageBox(“Digite um HostName ou um End. IP”,
“Error”, MB_OK);
exit;
end;
HNDicmp := LoadLibrary(“ICMP.DLL”);
if (HNDicmp <> 0) then begin
@IcmpCreateFile := GetProcAddress(HNDicmp,”IcmpCreateFile”);
@IcmpCloseHandle := GetProcAddress(HNDicmp,”IcmpCloseHandle”);
@IcmpSendEcho := GetProcAddress(HNDicmp,”IcmpSendEcho”);
if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or
(@IcmpSendEcho=nil) then begin
Application.MessageBox ("Erro pegando endereзos ICMP", "Error", MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);

if (Retorno <> 0) then begin
Application.MessageBox ("Nгo foi possнvel carregar WinSockets",
“WSAStartup”,MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));
if (Destino.S_addr = 0) then begin
Host := GetHostbyName(PChar(Edit1.text));
end
else begin
Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
end;

if (host = nil) then begin
Application.MessageBox ("Host nгo encontrado", "Error", MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
exit;
end;
memo1.Lines.Add(“Pinging ” + Edit1.text);

Endereco := @Host.h_addr_list;

HNDFile := IcmpCreateFile();
for x:= 0 to 4 do begin
Ip.Ttl := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(0);
Ip.Options := nil;

dwRetorno := IcmpSendEcho(
HNDFile,
Endereco^,
null,
0,
Ip,
Icmp,
sizeof(Icmp),
DWORD(5000));
Destino.S_addr := icmp.source;
Memo1.Lines.Add(“Pingou ” + Edit1.text);
end;

IcmpCLoseHandle(HNDFile);
FreeLibrary(HNDicmp);
WSACleanup();
end;

end.

Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*