PDA

Просмотр полной версии : Ping


Duh
09.09.2004, 23:10
как можно реализовать пинг 2-х серваков одновременно (внутри сетки и вне сетки [И-нет])???
Желательно на языках: Дельфи, ВБ....можно и Си...но его я хуже знаю....а надо будет прогу писать понятную пользователям...=)
:biggrin:

Don
09.09.2004, 23:38
Можно создать два потока (TThread) и пинговать параллельно.

Duh
10.09.2004, 00:34
Don
а можно поконкретнее...просто я вообще с сеткой раньше не работал...=\
Это компонента такая? О.о

Don
13.09.2004, 23:47
THread - это класс представляющий собой отдельный поток Windows. К сетям отношения не имеет - нужно чтобы выполнять какие-то действия паралельно (например писать на диск, выводть прогресс, и играть в сапера - причем в одном окне). А вот как реализовать ping я точно сказать не могу

Duh
14.09.2004, 00:07
угу...я уже покопался в НЭТе... по поводу TThread кой-чё нашёл....вообще-то меня именно Пинг и интересовал в первую очередь....=\

dyr_farot
14.09.2004, 11:07
вот про пинг:

Протокол Ping предназначен для тестирования компьютерных соединений в Интернете путём посылки через протокол Internet Protocol (IP) по обределённому адресу сообщения и ожидания от него ответа.

ICMP - Internet Control Message Protocol. ICMP служит для передачи сообщений об ошибках а так же управляющих сообщений . ICMP-тест может показать насколько быстро проходит информация между двумя узлами в Интернете.
Запускаем Delphi;
В Новом проекте добавляем в форму Tbutton, Tedit и Tmemo;
Вставляем “winsock”;
объявляем структурку для 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.

Duh
14.09.2004, 19:58
спасибо....щас попробую...8-)
:biggrin:

helldomain
15.09.2004, 05:41
Gde-to chital, chto pod XP i 2K3 mojno ispolzowat ICMP pryamo cherez packet socket.

Duh
15.09.2004, 10:30
helldomain
mne-bi hot' kak-to sdelat'.....4tobi na vseh OS rabotalo....8-)

dyr_farot
15.09.2004, 11:45
на всех осях это и под виндой и под никсами что ли?

Duh
15.09.2004, 14:38
не...я только Винды имел ввиду....сомневаюсь, что у наших клиентов Линукс хоть у кого-то стоит....8-)

dyr_farot
15.09.2004, 14:41
ну тогда тот код -- самое оно -- под все винды подходит ( исключая 3.1 разве что :) )

Duh
15.09.2004, 17:28
nuuuu....tam vrode TAKIH OSei netu...=)
Ja esse i 95 u nih ne videl....=)
:biggrin:

NEBULON-77
18.09.2004, 21:23
В базовой конфигурации Delphi 7 среди VCL компонентов INDY library есть компонент ICMP Client ( класс TIdIcmpClient )
Работать с этим классом очень просто

Вот пример задания параметров:

IdIcmpClient1.Host:='www.ru' ;
IdIcmpClient1.ReceiveTimeout:= 1000 ;
IdIcmpClient1.Ping;

Остается только обработать событие OnReply:
procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
const AReplyStatus: TReplyStatus);
begin
valPing:= AReplyStatus.MsRoundTripTime ;
end;

valPing и есть величина пинга в ms.

( valPing для примера - глобальная переменная , var valPing : integer ; )

Для пинговки 2го сервера , создать второй экземляр и работать с ним аналогично.

Duh
18.09.2004, 22:21
у мен нету 7-й версии...=\ возможность скачать есть...но на том компе места нету... там винт всего на 800 метров...8-)

Я уже нашёл набор компонент (названия не помню...=\)...и там есть Пинг...одна проблема - одновременно они не работают...=\

NEBULON-77
как только качаю дельфю 7-ю попробую... ;)
вот всяком случае - твой вариант проще, чем та коомпонента, которую я нашёл.... ;)

З.Ы. всем спасибо...
З.З.Ы. принимаются и другие варианты...если кому ещё понадобится...чтоб вопросов меньше было... ;)

Ghost
30.10.2004, 18:43
Пингую способом, который описал NEBULON-77. Все нормально работает, но иногда случается какая-то хрень: периодически вылетает ошибка 'Non-echo type response received'. Причем, раз на раз не приходится: бывает вылетает, бывает - нет, короче, ведет себя абсолютно независимо. :idontnow: Запускаю прогу - получил ответ, через пять минут опять запускаю - ошибка. Причем пингуемый комп никто не трогает - он стоит рядом и на него никто не дышит... Как решить проблему, подскажите. :help:

Добавлено чер пол-часика...

Черт возьми. Теперь вообще выскакивает ошибка 'Socket Error # 10022 Invalid argument', хотя ничего не менял. Причем, эта ошибка вываливается даже тогда, когда пингуются хосты ранее ошибок невызывающие... :idontnow:

Duh
31.10.2004, 22:35
Ghost
попробуй как я сделал...найди компоненту пинга......8-)
там есть кой-какие ограничения....зато ошибок непонятных не вылетает...... :biggrin:

/7y3uK
31.10.2004, 23:57
Если компонент, то на торри как всегда полно всякого разного и фриварного VCL :):) причем я особо не вчитывался, но похоже есть то, что тебе нужно.
Вот тебе ссылка, тама в поиске ping набери:
_http://www.torry.net

antonprk
13.11.2004, 21:17
нда серваки на Windах, на юнихах даже таких вопросов не возникает...