Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.137.180.32] |
|
Сообщ.
#1
,
|
|
|
Ping средствами Delphi
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 на своем компьютере в командной строке, следует набрать: C:\>ping 127.0.0.1 Результатом данной команды будет: Обмен пакетами с 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); При подготовке данной статьи были использованы следующие материалы: Общее представление о пинге (Википедия) Процедура принятия результатов работы консольного приложения (DRKB) Добавлено Пинг можно реализовать компонентом IdIcmpClient со страницы IndyClient, используя его метод ping и считывая потом ReplyStatus. Пример кода: IdIcmpClient1.Ping; Memo1.Lines.Add(IntToStr(IdIcmpClient1.ReplyStatus.TimeToLive)); |
Сообщ.
#2
,
|
|
|
Если нет желания связывается с 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); |
Сообщ.
#3
,
|
|
|
А чем так уж Indy не угодили? Или хотя бы ICS?
|
Сообщ.
#4
,
|
|
|
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. |
Сообщ.
#5
,
|
|
|
Вот уединенный модуль пинга.
Добавлено Во ещё один пример. Надо использовать компонент 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; Прикреплённый файлping.rar (3.18 Кбайт, скачиваний: 946) |