Главная » 2009 Ноябрь 6 » Небольшое PING-приложение
08:38 Небольшое PING-приложение |
Протокол 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; type ICMPECHO = record Source :longint; Status :longint; RTTime :longint; DataSize:Shortint; Reserved:Shortint; pData :^variant; i_ipinfo:IPINFO; end; 6. Объявляем функции и процедуры, которые мы будем вызывать из ICMP.DLL 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} 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} 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. Это всё….. Источник: http://www.sources.ru |
|
|
| Всего комментариев: 1 | |
|
| |
