PDA

Ver la Versión Completa : Detectar ip impresra de red


oec2509
19-05-2016, 01:18:15
Primero que nada muy buenas tardes para todos, saludos desde Costa Rica.

Tengo una aplicación que está en funcionamiento desde hace ya algunos años, se trata de un programa que esta constantemente ejecutandose a espera de ordenes de producción, cuando estas llegan, las envia a una o mas impresoras según el tipo de producto, resulta que estas impresoras son impresoras de red con una IP definida. para poder saber si la impresora está en linea se realiza un ping a la misma, si responde se envía la impresión y sino sigue chequeando cada cierto tiempo hasta que la impresora se encuentre el linea.

Para poder realizar esa verificación utilizo este utilitario:

unit raw_ping;

interface
uses
Windows, SysUtils, Classes;

type
TSunB = packed record
s_b1, s_b2, s_b3, s_b4: byte;
end;

TSunW = packed record
s_w1, s_w2: word;
end;

PIPAddr = ^TIPAddr;
TIPAddr = record
case integer of
0: (S_un_b: TSunB);
1: (S_un_w: TSunW);
2: (S_addr: longword);
end;

IPAddr = TIPAddr;

function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcall; external 'icmp.dll'
function IcmpSendEcho (IcmpHandle : THandle; DestinationAddress : IPAddr;
RequestData : Pointer; RequestSize : Smallint;
RequestOptions : pointer;
ReplyBuffer : Pointer;
ReplySize : DWORD;
Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';


function Ping(InetAddress : string) : boolean;

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 getting IP from HostName');
end;
end
else
begin
raise Exception.Create('Error getting HostName');
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;

end.

Este me funciono perfecto mientras lo ejecute bajo un ambiente WINDOWS SERVER 2003, ahora lo trato de ejecutar en WINDOWS 10 si siempre me devuelve como si la impresora estuviese apagada.

en esta instruccionDW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0)siempre devuelve 0 sin importar si la impresora esta apagado o no.

La verdad entiendo casi nada del código, Yo solo se que enviaba la direccion IP y me decia si estaba en línea o no

No se que buscar, para tratar de corregir esta situación, si alguien me pudiese orientar les agradeceria mucho y si alguien tuviese una rutina mas moderna para este proceso sería perfecto.

También escucho sugerencias alternativas de como resolver mi situación.

Trabajo con Delphi 2007 bajo ambiente windows server 2012 r2 y estaciones de trabajo windows 10

Nuevamente muy agradecido con la ayuda que me puedan brindar.

Neftali [Germán.Estévez]
19-05-2016, 09:22:51
Desactiva el firewall de forma temporal para descartar que sea problemas de permisos.

Por aquí hablan (http://www.delphi-central.com/tutorials/icmp-ping.aspx)de que las llamadas a ICMP.DLL puedes necesitar permisos extra, a diferencia del PING.

bitbow
19-05-2016, 17:36:49
Tambien puedes validar la compatibilidad de aplicación con el solucionador de problemas, define esta como compatibilidad con windows 7 o windows XP (aunque parezca de chiste llega a funcionar).

Windows 8.1 y 10 vinieron a complicar algunos temas que ya estaba trabajados en los windows previos.

Saludos y suerte.

oec2509
19-05-2016, 18:53:10
Desactiva el firewall de forma temporal para descartar que sea problemas de permisos.

Por aquí hablan (http://www.delphi-central.com/tutorials/icmp-ping.aspx)de que las llamadas a ICMP.DLL puedes necesitar permisos extra, a diferencia del PING.


Muchas gracias por responder.

desactive el firewall y no hay cambio alguno

Sigo en busca de una solución, gracias de todos modos.

engranaje
22-05-2016, 09:53:12
Lo normal en estos casos suele ser que entre la versión del so en la que el código funcionaba correctamente y la versión en la que ya no funciona haya habido algún cambio en la Api. En estos casos lo mejor es ir a msd y comprobarlo.
https://msdn.microsoft.com/es-es/library/windows/desktop/aa366050%28v=vs.85%29.aspx

Por lo que veo el problema está en el último parámetro que pasas en
IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0)

Estás pasando como timeout un 0 y al parecer en las últimas versiones de IcmpSendEcho es necesario pasar como timeout un valor mayor que 0

escafandra
22-05-2016, 18:36:04
Te muestro una Unit simple para hacer ping por código. Te permite direcciones en formato IP o Web:


unit UPing;

interface

uses
Windows, WinSock;

function IcmpCreateFile: Integer; stdcall external 'iphlpapi'
function IcmpSendEcho(Handle, Address: Integer; RequestData: PChar; RequestSize: Word; RequestOptions, ReplyBuffer: PChar; ReplySize, TimeOut: Cardinal): Cardinal; stdcall external 'iphlpapi';
function IcmpCloseHandle(IcmpHandle: Cardinal): boolean; stdcall external 'iphlpapi'
function Ping(Addr: PCHAR; Rep: integer = 3): boolean;

type
ICMP_OPTION_INFORMATION = packed record
Ttl: u_char;
Tos: u_char;
Flags: u_char;
OptionsSize: u_char;
OptionsData: Pointer;
end;
PICMP_OPTION_INFORMATION= ^ICMP_OPTION_INFORMATION;

ICMP_ECHO_REPLY = packed record
Address: Cardinal;
Status: Cardinal;
RoundTripTime: Cardinal;
DataSize: Word;
Reserved: Word;
Data: Pointer;
Options: ICMP_OPTION_INFORMATION;
end;
PICMPP_ECHO_REPLY = ^ICMP_ECHO_REPLY;

implementation

function Ping(Addr: PCHAR; Rep: integer = 3): boolean;
var
WSA: TWSAData;
hIcmpFile: Cardinal;
Reply: ICMP_ECHO_REPLY;
He: Phostent;
begin
Result:= false;

// Inicializar WinSock
if WSAStartup(MAKEWORD(1, 1), WSA) <> 0 then exit;

//Obtener IP de Addr
He:= gethostbyname(Addr);
if He = nil then exit;

// Envia Ping
hIcmpFile:= IcmpCreateFile;
repeat
Result:= IcmpSendEcho(hIcmpFile, PULONG(He.h_addr_list^)^, 0, 0, 0, PCHAR(@Reply), sizeof(ICMP_ECHO_REPLY), 1000) <> 0;
Result:= Result and (Reply.Status = 0); // Error en Ping el Host no lo recibe....
dec(Rep);
until Result or (Rep = 0);

// Cerrar...
IcmpCloseHandle(hIcmpFile);
WSACleanup;
end;

end.


Saludos.

oec2509
31-05-2016, 21:59:52
Lo normal en estos casos suele ser que entre la versión del so en la que el código funcionaba correctamente y la versión en la que ya no funciona haya habido algún cambio en la Api. En estos casos lo mejor es ir a msd y comprobarlo.
https://msdn.microsoft.com/es-es/library/windows/desktop/aa366050%28v=vs.85%29.aspx

Por lo que veo el problema está en el último parámetro que pasas en
Código Delphi [-] (http://www.clubdelphi.com/foros/#)IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0)


Estás pasando como timeout un 0 y al parecer en las últimas versiones de IcmpSendEcho es necesario pasar como timeout un valor mayor que 0

Buenas tardes, quiero agradacer a todos los que de una forma u otra trataron de ayudar con mi situación, de verdad gracias por invertir de su valioso tiempo para compartir con otros sus conocimientos.

La solución al problema presentado fue cambiar el valor de timeout de 0 a 5, porque 5? no se;pero fue el que funcionó.

Muchas gracias amigos de Club Dephi. Saludos desde Costa Rica.