Ping средствами Delphi

  • Автор темы onyx
  • Дата начала
O

onyx

#1
Ping — это служебная компьютерная программа, предназначенная для проверки соединений в сетях на основе TCP/IP.

Она отправляет запросы Echo-Request протокола ICMP указанному узлу сети и фиксирует поступающие ответы (ICMP Echo-Reply). Время между отправкой запроса и получением ответа позволяет определять двусторонние задержки (RTT) по маршруту и частоту потери пакетов, то есть косвенно определять загруженности каналов передачи данных и промежуточных устройств.

Также пингом называется время, затраченное на передачу пакета информации в компьютерных сетях от клиента к серверу и обратно от сервера к клиенту, оно измеряется в миллисекундах. Время пинга связано со скоростью соединения и загруженностью каналов на всём протяжении от клиента к серверу.

Полное отсутствие ICMP-ответов может также означать, что удалённый узел (или какой-либо из промежуточных маршрутизаторов) блокирует ICMP Echo-Reply или игнорирует ICMP Echo-Request.

А теперь конкретно на примерах.

В основу одного из самого простого способа можно положить стандартную утилиту командной строки ping.exe, входящую в состав Windows.
Команда Ping лежит в основе диагностики сетей TCP/IP. Например, чтобы быстро получить значения параметров конфигурации TCP/IP на своем компьютере в командной строке, следует набрать:
Результатом данной команды будет:
Обмен пакетами с 127.0.0.1 по 32 байт:
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Статистика Ping для 127.0.0.1:
Пакетов: отправлено = 4, получено = 4, потеряно = 0 (0% потерь),
Приблизительное время приема-передачи в мс:
Минимальное = 0мсек, Максимальное = 0 мсек, Среднее = 0 мсек
Более подробное описание этой утилиты есть в справке Windows, не будем на этом зацикливаться.
Так вот, принцип работы delphi-приложения, основанного на данной утилите, будет не сложным. Будет необходимым передать утилите необходимые параметры, а именно IP-адрес, и принять результат работы. Не сложно, правда?
Вот небольшая процедурка:

Код:
procedure Ping(IP: String; OutMemo:TMemo);
const BUFSIZE = 2000;
var SecAttr	: TSecurityAttributes;
hReadPipe,
hWritePipe : THandle;
StartupInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer	 : Pchar;
WaitReason,
BytesRead : DWord;
begin
with SecAttr do
begin
nlength			 := SizeOf(TSecurityAttributes);
binherithandle	  := true;
lpsecuritydescriptor := nil;
end;
if Createpipe (hReadPipe, hWritePipe, @SecAttr, 0) then
begin
Buffer := AllocMem(BUFSIZE + 1);
FillChar(StartupInfo, Sizeof(StartupInfo), #0);
StartupInfo.cb		 := SizeOf(StartupInfo);
StartupInfo.hStdOutput := hWritePipe;
StartupInfo.hStdInput  := hReadPipe;
StartupInfo.dwFlags	 := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil,
PChar('ping.exe '+IP),
@SecAttr,
@SecAttr,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
StartupInfo,
ProcessInfo) then
begin
repeat
WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100);
Application.ProcessMessages;
until (WaitReason <> WAIT_TIMEOUT);
Repeat
BytesRead := 0;
ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
OutMemo.Text := OutMemo.text + String(Buffer);
until (BytesRead < BUFSIZE);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(hReadPipe);
CloseHandle(hWritePipe);
end;
end;
Процедура отправляет IP адрес и возвращает в TMemo результат работы.
Вот пример использования:
Код:
Ping('127.0.0.1', Memo1);
Пинг можно реализовать компонентом IdIcmpClient со страницы IndyClient, используя его метод ping и считывая потом ReplyStatus.
Код:
IdIcmpClient1.Ping;
Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive));

Если нет желания связывается с Idy можно использовать библиотеку "ICMP.DLL"
Код:
uses
WinSock;

type
ip_option_information = packed record // Информация заголовка IP (Наполнение
// этой структуры и формат полей описан в RFC791.
Ttl : byte;		 // Время жизни (используется traceroute-ом)
Tos : byte;		 // Тип обслуживания, обычно 0
Flags : byte;	  // Флаги заголовка IP, обычно 0
OptionsSize : byte;	 // Размер данных в заголовке, обычно 0, максимум 40
OptionsData : Pointer; // Указатель на данные
end;

icmp_echo_reply = packed record
Address : u_long;			// Адрес отвечающего
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()
DestAddress : 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'; 

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;
begin

// Создаем 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('Error in call to '+
'WSAStartup().');
Memo1.Lines.Add('Error code: '+IntToStr(error));
Exit;
end;

pHostEn := gethostbyname('172.16.10.1');
error := GetLastError();
if (error <> 0) then
begin
Memo1.SetTextBuf('Error in call to'+
'gethostbyname().');
Memo1.Lines.Add('Error code: '+IntToStr(error));
Exit;
end;

destAddress := PInAddr(pHostEn^.h_addr_list^)^;

// Посылаем ping-пакет
Memo1.Lines.Add('Pinging ' +
pHostEn^.h_name+' ['+
inet_ntoa(destAddress)+'] '+
' with '+
IntToStr(sizeof(pingBuffer)) +
' bytes of data:');

IcmpSendEcho(hIP,
destAddress.S_addr,
@pingBuffer,
sizeof(pingBuffer),
Nil,
pIpe,
sizeof(icmp_echo_reply) + sizeof(pingBuffer),
5000);

error := GetLastError();
if (error <> 0) then
begin
Memo1.SetTextBuf('Error in call to '+
'IcmpSendEcho()');
Memo1.Lines.Add('Error code: '+IntToStr(error));
Exit;
end;

// Смотрим некоторые из вернувшихся данных
Memo1.Lines.Add('Reply from '+
IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
IntToStr(HiByte(HiWord(pIpe^.Address))));
Memo1.Lines.Add('Reply time: '+IntToStr(pIpe.RTTime)+' ms');

IcmpCloseHandle(hIP);
WSACleanup();
FreeMem(pIpe);
end;
А вот таким незаурядным кодом в одну строку можно вывести в командной строке результат пинга адреса:
Код:
WinExec(pchar('ping.exe sources.ru'), sw_show);

ICS - Internet Component Suite - богатый набор компонентов (TWSocket (TCP/IP, UDP - клиент, сервер), TsmtpCli (отправка почты), Tpop3Cli (получение почты), TftpCli (FTP клиент), TFtpSrv (FTP Сервер), ThttpCli (Веб клиент), THttpSrv (Веб сервер), Tping (он родимый и есть) и тд. и тп.). Скачать этот набор можно здесь.
Для пинга необходим лишь TPing.
Вот исходник-пример для пинга из архива с компонентом:
Код:
unit PingTst1;

interface

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

type
TPingTstForm = class(TForm)
Ping1: TPing;
Label1: TLabel;
HostEdit: TEdit;
PingButton: TButton;
DisplayMemo: TMemo;
CancelButton: TButton;
procedure PingButtonClick(Sender: TObject);
procedure Ping1Display(Sender: TObject; Icmp: TObject; Msg: String);
procedure Ping1DnsLookupDone(Sender: TObject; Error: Word);
procedure CancelButtonClick(Sender: TObject);
procedure Ping1EchoRequest(Sender: TObject; Icmp: TObject);
procedure Ping1EchoReply(Sender: TObject; Icmp: TObject; Error: Integer);
private
{ Dйclarations privйes }
public
{ Dйclarations publiques }
end;

var
PingTstForm: TPingTstForm;

implementation

{$R *.DFM}


procedure TPingTstForm.PingButtonClick(Sender: TObject);
begin
DisplayMemo.Clear;
DisplayMemo.Lines.Add('Resolving host ''' + HostEdit.Text + '''');
PingButton.Enabled  := FALSE;
CancelButton.Enabled := TRUE;
Ping1.DnsLookup(HostEdit.Text);
end;


procedure TPingTstForm.Ping1DnsLookupDone(Sender: TObject; Error: Word);
begin
CancelButton.Enabled := FALSE;
PingButton.Enabled  := TRUE;

if Error <> 0 then begin
DisplayMemo.Lines.Add('Unknown Host ''' + HostEdit.Text + '''');
Exit;
end;

DisplayMemo.Lines.Add('Host ''' + HostEdit.Text + ''' is ' + Ping1.DnsResult);
Ping1.Address := Ping1.DnsResult;
Ping1.Ping;
end;


procedure TPingTstForm.Ping1Display(Sender: TObject; Icmp: TObject; Msg: String);
begin
DisplayMemo.Lines.Add(Msg);
end;




procedure TPingTstForm.CancelButtonClick(Sender: TObject);
begin
Ping1.CancelDnsLookup;
end;



procedure TPingTstForm.Ping1EchoRequest(Sender: TObject; Icmp: TObject);
begin
DisplayMemo.Lines.Add('Sending ' + IntToStr(Ping1.Size) + ' bytes to ' +
Ping1.HostName + ' (' + Ping1.HostIP + ')');
end;



procedure TPingTstForm.Ping1EchoReply(Sender: TObject; Icmp: TObject; Error: Integer);
begin
if Error = 0 then
DisplayMemo.Lines.Add('Cannot ping host (' + Ping1.HostIP + ') : ' +
Ping1.ErrorString)
else
DisplayMemo.Lines.Add('Received ' + IntToStr(Ping1.Reply.DataSize) +
' bytes from ' + Ping1.HostIP +
' in ' + IntToStr(Ping1.Reply.RTT) + ' msecs');
end;

end.
Вот ещё один пример. Надо использовать компонент IdIcmpClient. Этот включает метод Ping, который осуществляет запрос. Информация о посланном ping получена в свойство ReplyStatus компонента. Находим там число полученных байтов (BytesReceived), время в тысяче секунд (MsRoundTripTime), TTL пакета (TimeToLive), и т.д.. Вот в качестве примера функция, позволяющая определить ping, указываем IP или имя. Передаем также в параметре число отправлений, которое должны делать (чем больше число pings, тем результат будет точнее, но операция будет более медленнее выполняться), и Double переменная, в которую поместим результат. Функция отсылает true, если все прошло успешно, false в случае провала:
Код:
function TForm1.Ping(const AHost : string; const ATimes : integer;
out AvgMS:Double) : Boolean;
var
R : array of Cardinal;
i : integer;
begin
Result := True;
AvgMS := 0;
if ATimes>0 then
with TIdIcmpClient.Create(Self) do
try
Host := AHost;
ReceiveTimeout:=999; //TimeOut du ping
SetLength(R,ATimes);
{Pinguer le client}
for i:=0 to Pred(ATimes) do
begin
try
Ping();
Application.ProcessMessages; //ne bloque pas l'application
R[i] := ReplyStatus.MsRoundTripTime;
except
Result := False;
Exit;

end;
if ReplyStatus.ReplyStatusType<>rsEcho Then result := False; //pas d'écho, on renvoi false.
end;
{Faire une moyenne}
for i:=Low(R) to High(R) do
begin
Application.ProcessMessages;
AvgMS := AvgMS + R[i];
end;
AvgMS := AvgMS / i;
finally
Free;
end;
end;
(с) Статья практически не моя. Сам собрал лишь одну процедуру, а остальное путем серфинга собирал, переводи т.д., в основном с немецких сайтов (подозрительно... видать гитлеры не все вымерли, пробивают айпишнеги блин) + на Вики брал основное понятие пинга. :blink:
 
O

onyx

#2
<!--QuoteBegin-sax_ol+30:12:2007, 23:21 -->
<span class="vbquote">(sax_ol @ 30:12:2007, 23:21 )</span><!--QuoteEBegin-->а не проще заюзать Indy?
[snapback]91896" rel="nofollow" target="_blank[/snapback]​
[/quote]
Если бы ты прочитал все, то ты бы не задал этот вопрос. :)
 
O

onyx

#3
<!--QuoteBegin-sax_ol+31:12:2007, 16:31 -->
<span class="vbquote">(sax_ol @ 31:12:2007, 16:31 )</span><!--QuoteEBegin-->Много букав
[snapback]91938" rel="nofollow" target="_blank[/snapback]​
[/quote]
Ну... мое дело маленькое. :)
 

valentofer

Active member
10.11.2007
38
0
#4
<!--QuoteBegin-onyx+30:12:2007, 19:47 -->
<span class="vbquote">(onyx @ 30:12:2007, 19:47 )</span><!--QuoteEBegin-->Пинг можно реализовать компонентом IdIcmpClient со страницы IndyClient, используя его метод ping и считывая потом ReplyStatus.
Код
IdIcmpClient1.Ping;
Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive));
[snapback]91882" rel="nofollow" target="_blank[/snapback]​
[/quote]
только в Delphi 2007(в ранних не знаю), в компоненте IdIcmpClient1 нету ReplyStatus и TimeToLive ;) А так должно работать :wacko:
 
3

3uM6a

#5
Хотелось бы узнать как лучше узнать есть ли коннект к интернету ? Ping ом или днслукапом? Смысл в том чтобы функция возвращала true или false ! ПОдскажите как лучше реализовать ?
 

Kmet

Java Team
25.05.2006
1 036
8
#6
не раз обсуждалось. в общем случае надежного решения нет. имхо лучший вариант дергать надежный сервис (гугл, яху...)
 
E
#7
Зачем дергать чтото "надежное"? Дергать надо тог что надо приложению. Иначе дернут гугл - инет есть - дернут свое - инета нет - и так по циклу .... :unsure:
 

Kmet

Java Team
25.05.2006
1 036
8
#8
с чего ты взял, что приложению обязательно что то надо?! может оно тупо мониторит соединение.