Реализация PING'а -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [18.191.88.249]

Модераторы: Rouse_, jack128, Krid

Реализация PING'а

Song

Сообщ. #1 , 06.12.03, 06:17

Unregistered

Протокол 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.

.failer

Сообщ. #2 , 16.11.04, 01:26

Profi

Профиль · PM

еще одна реализация ping (запрос - ожидание ответа)
На форме использовал одно Memo, для конторля.
Для запуска программы на системе NT необходимы права администратора.

Заголовог

icmphead = record

icmp_type: byte;

icmp_code: byte ;

icmp_chksum: word;

icmp_id: word;

icmp_seq: word;

icmp_data: array [0..55] of byte; // можно больше а можно и меньше

end;

сама функция пинга (параметр - ip который надо пингануть).

function ping(ip: DWORD): bool;

var

s: integer;

pid: WORD;

sai: tsockaddrin;

size: integer;

icmp: icmphead;

len: integer;

flag: bool;

buf: array [0..255] of byte;

picmp: ^icmphead;

begin

flag:=false;

pid:=word(GetCurrentProcessId);

s:=socket(AF_INET, SOCK_RAW, IPPROTO_ICMP);

if(s<0) then

form1.Memo1.Lines.Add('socket error'); // это так для теста, если вдруг сокет не создан

FillChar(sai, sizeof(sai), 0);

sai.sin_family:=AF_INET;

sai.sin_addr.S_addr:=inet_addr(ip);

connect(s, sai, sizeof(sai));

icmp.icmp_type := 8;

icmp.icmp_code := 0;

icmp.icmp_id := pid;

icmp.icmp_seq := 1;

len := sizeof(icmp);

icmp.icmp_chksum := 0;

icmp.icmp_chksum := in_cksum(icmp, len);

send(s, icmp, sizeof(icmp), 0); // посылаем

while not flag do

begin

recv(s, buf, 256, 0); // AHTUNG!!! вот тут тайм аут нужен.

// Можно SO_RCVTIMEO сокету поставить. иначе прога застынет

// "навсегда" в случае не ответа

picmp:=@buf[20];

form1.memo1.Lines.Add('recv '+ inttostr(picmp^.icmp_id)+' '+ inttostr(pid)); // это для контроля

flag:=(picmp^.icmp_id=pid); // это наш ответ?

end;

result:=picmp^.icmp_type; // возвращаем тип ICMP, если он 0 то это ответ.

end;

рассчет контроьной суммы (взято из Linux и переведено на делфи)

function in_cksum(var buf; len:integer):word;

var

p: pointer;

sum: longint;

i: integer;

begin

p:=@buf;

sum:=0;

for i:=1 to len div 2 do begin

sum:=sum+word(p^);

p:=pointer(longint(p)+2);

end;

if len mod 1<>0 then

sum:=sum+byte(p^);

sum:=(sum shr 16) + (sum and $ffff);

sum:=sum+(sum shr 16);

result:=word(NOT sum);

end;

все - проверено, работает.

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0368 ] [ 16 queries used ] [ Generated: 3.05.24, 15:01 GMT ]