imho.ws
IMHO.WS  

Вернуться   IMHO.WS > Компьютеры > Программирование
Опции темы
Старый 09.09.2004, 23:10     # 1
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
Ping

как можно реализовать пинг 2-х серваков одновременно (внутри сетки и вне сетки [И-нет])???
Желательно на языках: Дельфи, ВБ....можно и Си...но его я хуже знаю....а надо будет прогу писать понятную пользователям...=)
__________________
-Тут была реклама-
Duh вне форума  
Старый 09.09.2004, 23:38     # 2
Don
Guest
 
Сообщения: n/a

Можно создать два потока (TThread) и пинговать параллельно.
 
Старый 10.09.2004, 00:34     # 3
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
Don
а можно поконкретнее...просто я вообще с сеткой раньше не работал...=\
Это компонента такая? О.о
__________________
-Тут была реклама-
Duh вне форума  
Старый 13.09.2004, 23:47     # 4
Don
Guest
 
Сообщения: n/a

THread - это класс представляющий собой отдельный поток Windows. К сетям отношения не имеет - нужно чтобы выполнять какие-то действия паралельно (например писать на диск, выводть прогресс, и играть в сапера - причем в одном окне). А вот как реализовать ping я точно сказать не могу
 
Старый 14.09.2004, 00:07     # 5
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
угу...я уже покопался в НЭТе... по поводу TThread кой-чё нашёл....вообще-то меня именно Пинг и интересовал в первую очередь....=\
__________________
-Тут была реклама-
Duh вне форума  
Старый 14.09.2004, 11:07     # 6
dyr_farot
Advanced Member
 
Регистрация: 23.08.2003
Сообщения: 442

dyr_farot Нимб уже пробиваетсяdyr_farot Нимб уже пробивается
вот про пинг:

Протокол 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.
dyr_farot вне форума  
Старый 14.09.2004, 19:58     # 7
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
спасибо....щас попробую...8-)
__________________
-Тут была реклама-
Duh вне форума  
Старый 15.09.2004, 05:41     # 8
helldomain
Administrator
 
Аватар для helldomain
 
Регистрация: 13.05.2002
Сообщения: 11 227

helldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиург
helldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиургhelldomain Демиург
Gde-to chital, chto pod XP i 2K3 mojno ispolzowat ICMP pryamo cherez packet socket.
__________________
Осколки прошлого, как снег, закрутит ураган времён,
В ушедший день для нас навек, обрушив мост,
Оставив в наших душах след, тьма уплывёт за горизонт,
И в чистом небе вспыхнет свет, свет новых звёзд.
helldomain вне форума  
Старый 15.09.2004, 10:30     # 9
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
helldomain
mne-bi hot' kak-to sdelat'.....4tobi na vseh OS rabotalo....8-)
__________________
-Тут была реклама-
Duh вне форума  
Старый 15.09.2004, 11:45     # 10
dyr_farot
Advanced Member
 
Регистрация: 23.08.2003
Сообщения: 442

dyr_farot Нимб уже пробиваетсяdyr_farot Нимб уже пробивается
на всех осях это и под виндой и под никсами что ли?
dyr_farot вне форума  
Старый 15.09.2004, 14:38     # 11
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
не...я только Винды имел ввиду....сомневаюсь, что у наших клиентов Линукс хоть у кого-то стоит....8-)
__________________
-Тут была реклама-
Duh вне форума  
Старый 15.09.2004, 14:41     # 12
dyr_farot
Advanced Member
 
Регистрация: 23.08.2003
Сообщения: 442

dyr_farot Нимб уже пробиваетсяdyr_farot Нимб уже пробивается
ну тогда тот код -- самое оно -- под все винды подходит ( исключая 3.1 разве что )
dyr_farot вне форума  
Старый 15.09.2004, 17:28     # 13
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
nuuuu....tam vrode TAKIH OSei netu...=)
Ja esse i 95 u nih ne videl....=)
__________________
-Тут была реклама-
Duh вне форума  
Старый 18.09.2004, 21:23     # 14
NEBULON-77
Newbie
 
Аватар для NEBULON-77
 
Регистрация: 10.04.2004
Адрес: Матрица, Электростанция 66729
Сообщения: 38

NEBULON-77 Путь к славе только начался
В базовой конфигурации 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го сервера , создать второй экземляр и работать с ним аналогично.

Последний раз редактировалось NEBULON-77; 18.09.2004 в 21:26. Причина: добавление информации
NEBULON-77 вне форума  
Старый 18.09.2004, 22:21     # 15
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
у мен нету 7-й версии...=\ возможность скачать есть...но на том компе места нету... там винт всего на 800 метров...8-)

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

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

З.Ы. всем спасибо...
З.З.Ы. принимаются и другие варианты...если кому ещё понадобится...чтоб вопросов меньше было...
__________________
-Тут была реклама-
Duh вне форума  
Старый 30.10.2004, 18:43     # 16
Ghost
::VIP::
Звезда первого сезона
Молчун-2004
 
Аватар для Ghost
 
Регистрация: 24.08.2002
Сообщения: 1 575

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

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

Черт возьми. Теперь вообще выскакивает ошибка 'Socket Error # 10022 Invalid argument', хотя ничего не менял. Причем, эта ошибка вываливается даже тогда, когда пингуются хосты ранее ошибок невызывающие...
__________________
Действовать надо тупо и это лучшее доказательство нашей чистоты и силы!
Ghost вне форума  
Старый 31.10.2004, 23:35     # 17
Duh
Member
 
Аватар для Duh
 
Регистрация: 08.04.2002
Адрес: Estonia
Сообщения: 258

Duh Известность не заставит себя ждать
Ghost
попробуй как я сделал...найди компоненту пинга......8-)
там есть кой-какие ограничения....зато ошибок непонятных не вылетает......
__________________
-Тут была реклама-
Duh вне форума  
Старый 01.11.2004, 00:57     # 18
/7y3uK
Advanced Member
 
Аватар для /7y3uK
 
Регистрация: 09.03.2004
Адрес: толстозадая Москва
Сообщения: 498

/7y3uK Реально крут(а)/7y3uK Реально крут(а)/7y3uK Реально крут(а)/7y3uK Реально крут(а)
Если компонент, то на торри как всегда полно всякого разного и фриварного VCL причем я особо не вчитывался, но похоже есть то, что тебе нужно.
Вот тебе ссылка, тама в поиске ping набери:
_http://www.torry.net
/7y3uK вне форума  
Старый 13.11.2004, 22:17     # 19
antonprk
Guest
 
Сообщения: n/a

нда серваки на Windах, на юнихах даже таких вопросов не возникает...
 


Ваши права в разделе
Вы НЕ можете создавать новые темы
Вы не можете отвечать в темах.
Вы НЕ можете прикреплять вложения
Вы НЕ можете редактировать свои сообщения

BB код Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.

Быстрый переход


Часовой пояс GMT +4, время: 11:57.




Powered by vBulletin® Version 3.8.5
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.