procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
implementation
uses
WinSock;
function Fetch(var AInput: string; const ADelim: string = ' ';
const ADelete: Boolean = true) : string;
var
iPos: Integer;
begin
if ADelim = #0 then begin
// AnsiPos does not work with #0
iPos := Pos(ADelim, AInput);
end else begin
iPos := Pos(ADelim, AInput);
end;
if iPos = 0 then begin
Result := AInput;
if ADelete then begin
AInput := '';
end;
end else begin
result := Copy(AInput, 1, iPos - 1);
if ADelete then begin
Delete(AInput, 1, iPos + Length(ADelim) - 1);
end;
end;
end;
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
phe: PHostEnt;
pac: PChar;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
try
phe := GetHostByName(PChar(AIP));
if Assigned(phe) then
begin
pac := phe^.h_addr_list^;
if Assigned(pac) then
begin
with TIPAddr(AInAddr).S_un_b do begin
s_b1 := Byte(pac[0]);
s_b2 := Byte(pac[1]);
s_b3 := Byte(pac[2]);
s_b4 := Byte(pac[3]);
end;
end
else
begin
raise Exception.Create('Error al obtener la IP del equipo');
end;
end
else
begin
raise Exception.Create('Error al obtener el nombre de red');
end;
except
FillChar(AInAddr, SizeOf(AInAddr), #0);
end;
WSACleanup;
end;
function Ping(InetAddress : string) : boolean;
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
rep : array[1..128] of byte;
begin
result := false;
Handle := IcmpCreateFile;
if Handle = INVALID_HANDLE_VALUE then
Exit;
TranslateStringToTInAddr(InetAddress, InAddr);
DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
Result := (DW <> 0);
IcmpCloseHandle(Handle);
end;
type
ip_option_information = record
Ttl : byte;
Tos : byte;
Flags : byte;
OptionsSize : byte;
OptionsData : pointer;
end;
ICMP_ECHO_REPLY = record
Address : IPAddr;
Status : ULONG;
RoundTripTime : ULONG;
DataSize : Word;
Reserved : Word;
Data : Pointer;
Options : IP_OPTION_INFORMATION;
end;
var
formMenuPrincipal: TformMenuPrincipal;
implementation
{$R *.dfm}
function buscarElementoComboBox (
combo : TComboBox; elemento : string) : boolean;
var
i : integer;
begin
Result := false;
for i := 0 to combo.Items.Count - 1 do
begin
if AnsiUpperCase(combo.Items[i]) = AnsiUpperCase(elemento) then
begin
Result := true;
Exit;
end;
end;
end;
//lee un valor booleano de un fichero INI
function leBoolINI (clave, cadena : string; defecto : boolean) : boolean;
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
result := readbool (clave, cadena, defecto);
finally
free;
end;
end;
//lee un valor numérico de un fichero INI
function leNumINI (clave, cadena : string; defecto : Integer) : Integer;
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
result := ReadInteger (clave, cadena, defecto);
finally
free;
end;
end;
//lee un valor string de un fichero INI
function leCadINI (clave, cadena : string; defecto : String) : String;
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
result := ReadString (clave, cadena, defecto);
finally
free;
end;
end;
//escribe un valor string en un fichero INI
procedure esCadINI (clave, cadena : string; valor : String);
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
WriteString (clave, cadena, valor);
finally
free;
end;
end;
//escribe un valor boolean en un fichero INI
procedure esBoolINI (clave, cadena : string; valor : Boolean);
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
WriteBool (clave, cadena, valor);
finally
free;
end;
end;
procedure TformMenuPrincipal.btPingClick(Sender: TObject);
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
cnt : integer;
SAddr : string;
pnum : integer;
minTime : longint;
maxTime : longint;
allTime : longint;
stat : longint;
PingBuf : array[0..31] of char;
Reply : ICMP_ECHO_REPLY;
begin
if opLimpiar.Checked then
begin
txtResultado.Clear;
Refresh;
end;
if txtResultado.Text <> '' then
begin
txtResultado.Lines.Add('');
txtResultado.Lines.Add('');
end;
if ping(txtIP.Text) then
begin
txtResultado.Lines.Add (DateTimeToStr(Now) + ' ' +
'Realizando ping a ' + txtIP.Text + ' [OK]');
if not buscarElementoComboBox(txtIP, txtIP.Text) then
txtIP.Items.Add (txtIP.Text);
txtIP.Items.SaveToFile(
IncludeTrailingPathDelimiter (ExtractFilePath(Application.ExeName)) +
'equipos.txt');
end
else
txtResultado.Lines.Add (DateTimeToStr(Now) +
' Realizando ping a ' + txtIP.Text + ' [NO DISPONIBLE]');
Handle := IcmpCreateFile;
if Handle = INVALID_HANDLE_VALUE then
Halt(2);
TranslateStringToTInAddr(txtIP.Text, InAddr);
for cnt := 1 to StrToInt(txtNumRepeticiones.Text) do
begin
DW := IcmpSendEcho(Handle, InAddr, @PingBuf, strtoint(txtBytes.text), nil, @reply,
SizeOf(icmp_echo_reply) + strtoint(txtBytes.text), 3000);
if DW = 0 then
txtResultado.Lines.Add (DateTimeToStr(Now) +
' Tiempo de espera agotado')
else
begin
txtResultado.Lines.Add (DateTimeToStr(Now) +
(Format(' Respuesta desde %s: bytes = ' +
txtBytes.Text + ' tiempo=%dms TTL=%d',
[SAddr, Reply.RoundTripTime, Reply.Options.Ttl])));
stat := Reply.RoundTripTime;
inc(pnum);
if minTime > stat then
minTime := stat;
if maxTime < stat then
maxTime := stat;
AllTime := AllTime + stat;
end;
Sleep(StrToInt(txtTiempo.Text));
end;
IcmpCloseHandle(Handle);
Puede publicar nuevos temas en este foro No puede responder a temas en este foro No puede editar sus mensajes en este foro No puede borrar sus mensajes en este foro No puede votar en encuestas en este foro
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A