PING entre computadores

[dec]

Esta funcion 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, si alguien sabe porque por favor háganmelo saber.


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;

[vicacos]

Probe tu funcion pero no logre hacerla arrancar

[vicacos]

Probe tu funcion pero no logre hacerla arrancar