Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=39884&view=findpost&p=512744 Tue, 16 Nov 2004 01:26:19 +0000 Реализация PING'а https://forum.sources.ru/index.php?showtopic=39884&view=findpost&p=512744 На форме использовал одно Memo, для конторля.
Для запуска программы на системе NT необходимы права администратора.

Заголовог
      icmphead = record
        icmp_type: byte;
        icmp_code: byte ;
        icmp_chksum: word;
        icmp_id: word;
        icmp_seq: word;
        icmp_data: array [0..55] of byte; // можно больше а можно и меньше
      end;


сама функция пинга (параметр - ip который надо пингануть).
    function ping(ip: DWORD): bool;
    var
       s: integer;
       pid: WORD;
       sai: tsockaddrin;
       size: integer;
       icmp: icmphead;
       len: integer;
       flag: bool;
       buf: array [0..255] of byte;
       picmp: ^icmphead;
    begin
         flag:=false;
         pid:=word(GetCurrentProcessId);
         s:=socket(AF_INET, SOCK_RAW, IPPROTO_ICMP);
         if(s<0) then
                 form1.Memo1.Lines.Add('socket error'); // это так для теста, если вдруг сокет не создан
         FillChar(sai, sizeof(sai), 0);
         sai.sin_family:=AF_INET;
         sai.sin_addr.S_addr:=inet_addr(ip);
         connect(s, sai, sizeof(sai));
         icmp.icmp_type := 8;
         icmp.icmp_code := 0;
         icmp.icmp_id := pid;
         icmp.icmp_seq := 1;
         len := sizeof(icmp);
         icmp.icmp_chksum := 0;
         icmp.icmp_chksum := in_cksum(icmp, len);
         send(s, icmp, sizeof(icmp), 0); // посылаем
         while not flag do
         begin
              recv(s, buf, 256, 0);          // AHTUNG!!! вот тут тайм аут нужен.
                                             // Можно SO_RCVTIMEO сокету поставить. иначе прога застынет
                                             // "навсегда" в случае не ответа
              picmp:=@buf[20];
              form1.memo1.Lines.Add('recv '+ inttostr(picmp^.icmp_id)+' '+ inttostr(pid)); // это для контроля
              flag:=(picmp^.icmp_id=pid); // это наш ответ?
         end;
         result:=picmp^.icmp_type; // возвращаем тип ICMP, если он 0 то это ответ.
     
    end;



рассчет контроьной суммы (взято из Linux и переведено на делфи)

    function in_cksum(var buf; len:integer):word;
    var
      p: pointer;
      sum: longint;
      i: integer;
    begin
      p:=@buf;
      sum:=0;
      for i:=1 to len div 2 do begin
        sum:=sum+word(p^);
        p:=pointer(longint(p)+2);
        end;
      if len mod 1<>0 then
        sum:=sum+byte(p^);
     
      sum:=(sum shr 16) + (sum and $ffff);
      sum:=sum+(sum shr 16);
      result:=word(NOT sum);
    end;


все - проверено, работает.]]> .failer Интернет, сети, протоколы https://forum.sources.ru/index.php?showtopic=39884&view=findpost&p=258542 Sat, 06 Dec 2003 06:17:03 +0000 Реализация PING&#39;а https://forum.sources.ru/index.php?showtopic=39884&view=findpost&p=258542
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.
]]> Song Интернет, сети, протоколы