Status : u_long; // IP_STATUS
RTTime : u_long; // Время между эхо-запросом и эхо-ответом
// в миллисекундах
DataSize : u_short; // Размер возвращенных данных
Reserved : u_short; // Зарезервировано
Data : Pointer; // Указатель на возвращенные данные
Options : ip_option_information; // Информация из заголовка IP
end;
PIPINFO = ^ip_option_information;
PVOID = Pointer;
function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL' name 'IcmpCloseHandle';
function IcmpSendEcho(
IcmpHandle : THandle; // handle, возвращенный IcmpCreateFile()
estAddress : u_long; // Адрес получателя (в сетевом порядке)
RequestData : PVOID; // Указатель на посылаемые данные
RequestSize : Word; // Размер посылаемых данных
RequestOptns : PIPINFO; // Указатель на посылаемую структуру
// ip_option_information (может быть nil)
ReplyBuffer : PVOID; // Указатель на буфер, содержащий ответы.
ReplySize : DWORD; // Размер буфера ответов
Timeout : DWORD // Время ожидания ответа в миллисекундах
) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
hIP : THandle;
pingBuffer : array [0..31] of Char;
pIpe : ^icmp_echo_reply;
pHostEn : PHostEnt;
wVersionRequested : WORD;
lwsaData : WSAData;
error : DWORD;
destAddress : In_Addr;
s:pchar;
n,i : byte;
min, max: integer;
sr:real;
begin
Memo1.Lines.Add('--------------------------------------------------------------------------------------------------------------');
n := StrToInt(Edit2.Text);
// Создаем handle
hIP := IcmpCreateFile();
GetMem( pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
pIpe.Data := @pingBuffer;
pIpe.DataSize := sizeof(pingBuffer);
wVersionRequested := MakeWord(1,1);
error := WSAStartup(wVersionRequested,lwsaData);
if (error <> 0) then
begin
Memo1.SetTextBuf('Ошибка вызова функции '+
'WSAStartup().');
Memo1.Lines.Add('Код ошибки: '+IntToStr(error));
Exit;
end;
s := pchar(edit1.Text);
pHostEn := gethostbyname(s);
error := GetLastError();
if (error <> 0) then
begin
Memo1.SetTextBuf('Узел не найден');
Exit;
end;
destAddress := PInAddr(pHostEn^.h_addr_list^)^;
// Посылаем ping-пакет
Memo1.Lines.Add('Посылка пакета по адресу ' +
pHostEn^.h_name+' ['+
inet_ntoa(destAddress)+'] '+
' длиной '+
IntToStr(sizeof(pingBuffer)) +
' байта:');
//min := 255; max:=0; sr:= 0;
for i := 1 to n do
begin
IcmpSendEcho(hIP,
destAddress.S_addr,
@pingBuffer,
sizeof(pingBuffer),
nil,
pIpe,
sizeof(icmp_echo_reply) + sizeof(pingBuffer),
1000);
error := GetLastError();
if (error <> 0) then
begin
case error of
11010 : s:='Превышен интервал ожидания для запроса';
end;
Memo1.Lines.Add(s);
end
else
begin
// Смотрим некоторые из вернувшихся данных
Memo1.Lines.Add('Получен ответ от '+
IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
IntToStr(HiByte(HiWord(pIpe^.Address))));
Memo1.Lines.Add('Время между эхо-запросом и эхо-ответом: '+IntToStr(pIpe.RTTime)+' ms');
if i = 1 then
begin
min := pIpe.RTTime;
max := pIpe.RTTime;
sr := pIpe.RTTime;
end
else
begin
if pIpe.RTTime < min then min := pIpe.RTTime;
if pIpe.RTTime > max then max := pIpe.RTTime;
sr := sr + pIpe.RTTime;
end;
end;
end;
Memo1.Lines.Add('Статистика: ');
Memo1.Lines.Add('минимальное = '+inttostr(min)+'мс; максимальное = '+inttostr(max)+'мс; Среднее = '+floattostrf(sr/n,ffFixed,7,2)+' мс');
IcmpCloseHandle(hIP);
WSACleanup();
FreeMem(pIpe);
end;
end.
Результат роботи програми
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.