Просмотр полной версии : Ping
как можно реализовать пинг 2-х серваков одновременно (внутри сетки и вне сетки [И-нет])???
Желательно на языках: Дельфи, ВБ....можно и Си...но его я хуже знаю....а надо будет прогу писать понятную пользователям...=)
:biggrin:
Можно создать два потока (TThread) и пинговать параллельно.
Don
а можно поконкретнее...просто я вообще с сеткой раньше не работал...=\
Это компонента такая? О.о
THread - это класс представляющий собой отдельный поток Windows. К сетям отношения не имеет - нужно чтобы выполнять какие-то действия паралельно (например писать на диск, выводть прогресс, и играть в сапера - причем в одном окне). А вот как реализовать ping я точно сказать не могу
угу...я уже покопался в НЭТе... по поводу 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.
спасибо....щас попробую...8-)
:biggrin:
helldomain
15.09.2004, 05:41
Gde-to chital, chto pod XP i 2K3 mojno ispolzowat ICMP pryamo cherez packet socket.
helldomain
mne-bi hot' kak-to sdelat'.....4tobi na vseh OS rabotalo....8-)
dyr_farot
15.09.2004, 11:45
на всех осях это и под виндой и под никсами что ли?
не...я только Винды имел ввиду....сомневаюсь, что у наших клиентов Линукс хоть у кого-то стоит....8-)
dyr_farot
15.09.2004, 14:41
ну тогда тот код -- самое оно -- под все винды подходит ( исключая 3.1 разве что :) )
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го сервера , создать второй экземляр и работать с ним аналогично.
у мен нету 7-й версии...=\ возможность скачать есть...но на том компе места нету... там винт всего на 800 метров...8-)
Я уже нашёл набор компонент (названия не помню...=\)...и там есть Пинг...одна проблема - одновременно они не работают...=\
NEBULON-77
как только качаю дельфю 7-ю попробую... ;)
вот всяком случае - твой вариант проще, чем та коомпонента, которую я нашёл.... ;)
З.Ы. всем спасибо...
З.З.Ы. принимаются и другие варианты...если кому ещё понадобится...чтоб вопросов меньше было... ;)
Пингую способом, который описал NEBULON-77. Все нормально работает, но иногда случается какая-то хрень: периодически вылетает ошибка 'Non-echo type response received'. Причем, раз на раз не приходится: бывает вылетает, бывает - нет, короче, ведет себя абсолютно независимо. :idontnow: Запускаю прогу - получил ответ, через пять минут опять запускаю - ошибка. Причем пингуемый комп никто не трогает - он стоит рядом и на него никто не дышит... Как решить проблему, подскажите. :help:
Добавлено чер пол-часика...
Черт возьми. Теперь вообще выскакивает ошибка 'Socket Error # 10022 Invalid argument', хотя ничего не менял. Причем, эта ошибка вываливается даже тогда, когда пингуются хосты ранее ошибок невызывающие... :idontnow:
Ghost
попробуй как я сделал...найди компоненту пинга......8-)
там есть кой-какие ограничения....зато ошибок непонятных не вылетает...... :biggrin:
Если компонент, то на торри как всегда полно всякого разного и фриварного VCL :):) причем я особо не вчитывался, но похоже есть то, что тебе нужно.
Вот тебе ссылка, тама в поиске ping набери:
_http://www.torry.net
antonprk
13.11.2004, 21:17
нда серваки на Windах, на юнихах даже таких вопросов не возникает...
vBulletin® v3.8.5, Copyright ©2000-2024, Jelsoft Enterprises Ltd.