Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Usuario
· Wiki

Nick


Contraseña


Nuevo usuario


English
Hacer PING entre PCs de la red - Delphi
Lenguaje de programación Borland Delphi



interface
uses
    Winsock;

type
    IPINFO = record
             Ttl: Char;
             Tos: Char;
             IPFlags: Char;
             OptSize: Char;
             Options: ^Char;
	end;

     ICMPECHO = record
              Source: longInt;
              Status: longInt;
              RTTime: longInt;
              DataSize: ShortInt;
              Reserved: ShortInt;
              pData: ^Variant;
              i_ipinfo: IPINFO;
	end;

	TIcmpCreateFile = function(): Integer; stdcall;
	TIcmpCloseHandle = procedure(var handle: Integer); stdcall;
	TIcmpSendEcho = function(var handle: Integer; endereco:DWORD;
                            buffer:variant; tam:WORD; 
                            IP:IPINFO; ICMP:ICMPECHO;
                            tamicmp:DWORD; tempo:DWORD):DWORD; stdcall;

   function PingTo(vHost: String; vList: TStrings	= nil): Boolean;

implementation

function PingTo(vHost: String; vList: TStrings	= nil): Boolean;
var
   HNDicmp, hndFile,
   x, Retorno: Integer;
   wsadt: wsadata;
   icmp: Icmpecho;
   Host	: PHostEnt;
   Destino: In_addr;
   Endereco: ^DWORD;
   IP: IpInfo;
   dwRetorno: DWORD;
   IcmpCreateFile: TIcmpCreateFile;
   IcmpCloseHandle: TIcmpCloseHandle;
   IcmpSendEcho: TIcmpSendEcho;
begin
Result	:= False;
try
   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
           Raise Exception.Create('Error ICMP');
           FreeLibrary(HNDicmp);
           end;
      end;

   Retorno := WSAStartup($0101,wsadt);
   if( Retorno <> 0 )then begin
      Raise Exception.Create('No es posible cargar WinSock');
      WSACleanup();
      FreeLibrary(HNDicmp);
      end;

   Destino.S_addr := inet_addr(Pchar(vHost));

   if( Destino.S_addr = 0 )then begin
      Host := GetHostbyName(PChar(vHost));
      end 
   else begin
      Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
      end;

   if( Host = nil )then begin
      Raise Exception.Create('Host no encontrado');
      WSACleanup();
      FreeLibrary(HNDicmp);
      Exit;
      end;

   if( assigned(vList) ) then
      vList.Add('Ping a ' + vHost);

   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;

      if( assigned(vList) ) then
         vList.Add('Ping ' + vHost);
      end;

   try
      IcmpCLoseHandle(HNDFile);
   except
   end;
   Result	:= True;
finally
      FreeLibrary(HNDicmp);
      WSACleanup();
end;
end;
Nota: Esta función no es completamente funcional. Algunas veces no funciona con HostName, sólo con direcciones IP. La función IcmpCLoseHandle() no funciona del todo bien en máquinas con Windows NT.




Publicado el: 2003-11-08

Este sitio web NO CONTIENE malware, todos los programas con código fuente aquí. Autor: Alonso Javier Pérez Díaz Google+ Síguenos en Google+