Delphirus - прграммирование на delphi
   Все о delphi Delphirus - прграммирование на delphi
blocks.gif
Навигация
 

Главная
Статьи
Базы данных
Графика
Защита
Интернет
Система
Тексты
Мультимедиа
Файлы
Формы и окна
Другое
Советы
Базы данных
Графика
Интернет
Мультимедиа
Система
Тексты
Файлы
Файлы
Исходники
Компоненты
Инфо
Поиск по сайту
Обратная связь
Самое популярное
Аккаунт
Карта сайта

 
story.gif
Пингуем (Ping) под Delphi
 
Интернет

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



ICMP - Internet Control Message Protocol. ICMP служит для передачи сообщений об ошибках а так же управляющих сообщений . ICMP-тест может показать насколько быстро проходит информация между двумя узлами в Интернете.

  1. Запускаем Delphi;
  2. В Новом проекте добавляем в форму Tbutton, Tedit и Tmemo;
  3. Вставляем “winsock”;
  4. объявляем структурку для 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. 

Источник http://www.realcoding.net/

 
Разместил 31/01/2004 от rolcom ( Прочитано: )

  blocks.gif
Связанные ссылки
 

· Больше про Интернет
· Новость от rolcom


Самая читаемая статья: Интернет:
Создание многопользовательских приложений на базе сокетов

 
blocks.gif
Рейтинг статьи
 

Средняя оценка: 3.6
Ответов: 5


Пожалуйста, проголосуйте за эту статью:

Отлично
Очень хорошо
Хорошо
Нормально
Плохо


 
blocks.gif
опции
 


 Напечатать текущую страницу  Напечатать текущую страницу

 Отправить статью другу  Отправить статью другу

 
 

Page generation 0.048 seconds