Saber si hay internet
#1
Escrito 25 noviembre 2011 - 06:57
Existirá alguna manera de saber si estoy conectado a internet sin usar
ningún componente externo a lazarus (indy u otros)..... por ejemplo cuando deseo saber
si hay internet lo normal que hacía era poner en la consola de win2 :
ping www.google.com
Y si me salían unos numeritos entonces sabía que había línea, pero
como lo podría hacer en lazarus pascal ....??
PD: lo que deseo de momento es saber si hay internet en la pc osea si hay
línea.
#2
Escrito 28 noviembre 2011 - 08:39
#4
Escrito 28 noviembre 2011 - 12:37
#5
Escrito 28 noviembre 2011 - 01:09
http://www.lazarus.f...p?topic=10450.0
En linux verifica tus privilegios antes.
Saludos
#6
Escrito 28 noviembre 2011 - 06:52
voy a probar unos ejemplos y les comento........
#7
Escrito 29 noviembre 2011 - 12:28
Hola amiguitos les cuento mis avances, de momento estoy probando con el ejemplo de
escafandra para verificar la conexión a internet mediante una Unidad "Uping.pas" + Función
al probar estos ejemplos de los enlaces esto fue lo que paso:
- Agregué la Unidad Uping.pas a mi programita
- También le copie la función
- al darle en ejecutar me salió unos errores que logré arreglarlos añadiendo
punto y coma al final de:
function IcmpCreateFile: Integer; stdcall external 'iphlpapi'
y
function IcmpCloseHandle(IcmpHandle: Cardinal): boolean; stdcall external 'iphlpapi'
- Ahora cuando vuelvo a intentar me salé otro error en:
Result:= IcmpSendEcho(hIcmpFile, PULONG(He.h_addr_list^)^, 0, 0, 0, PCHAR(@Reply), sizeof(ICMP_ECHO_REPLY), 1000) <> 0;
le agregué un "^" a la parte "PULONG(He^.h_addr_list^)^" , ahora avanza un poquito y se vuelve a parar en:
0, 0, 0, PCHAR(@Reply)
los siguientes errores:
\UPing.pas(47,36) Hint: Local variable "WSA" does not seem to be initialized \UPing.pas(57,72) Error: Incompatible type for arg no. 5: Got "ShortInt", expected "PChar" \UPing.pas(9,10) Hint: Found declaration: IcmpSendEcho(LongInt,LongInt,PChar,Word,PChar,PChar,LongWord,LongWord):DWord; StdCall; \UPing.pas(69) Fatal: There were 1 errors compiling module, stopping
En esta parte ya no se que hacer......... les dejo el código pidiendo apoyo:
unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Uping; type { TForm1 } TForm1 = class(TForm) Button1: TButton; Label1: TLabel; procedure Button1Click(Sender: TObject); private { private declarations } public { public declarations } end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } function Ping(Addr: PCHAR; Rep: integer = 3): boolean; var WSA: TWSAData; hIcmpFile: Cardinal; Reply: ICMP_ECHO_REPLY; He: Phostent; n: Integer; 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; n:= 0; repeat Result:= IcmpSendEcho(hIcmpFile, PULONG(He.h_addr_list^)^, 0, 0, 0, PCHAR(@Reply), sizeof(ICMP_ECHO_REPLY), 1000) <> 0; if Result then Result:= Reply.Status = 0; // Error en Ping el Host no lo recibe.... inc(n); until Result or (n=3); // Cerrar... IcmpCloseHandle(hIcmpFile); WSACleanup; end; procedure TForm1.Button1Click(Sender: TObject); begin if Ping('[url=http://www.google.es]www.google.es[/url]') then Label1.Caption := 'Exito' else Label1.Caption := 'Fracaso'; end; end.
y también vuelvo a subir el ping de escafandra si es que se puede con su permiso.
#8
Escrito 29 noviembre 2011 - 05:34
Delphi y Lazarus difieren en algunas cosillas. Lazarus diferencia cuando usamos un puntero a una estructura, delphi nos deja usar una sintaxis como si de una variable, y no un puntero, se tratara. Así mismo, Lazarus es un poco mas estrictos con los tipos, un 0 no lo asimila a un nul.
Unos pequeños cambios hacen que la unidad UPing.pas compile y funcione:
// UPing for Lazarus // escafandra 2011 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^)^, nil, 0, nil, PCHAR(@Reply), sizeof(ICMP_ECHO_REPLY), 1000) <> 0; if Result then Result:= Reply.Status = 0; // Error en Ping el Host no lo recibe.... dec(Rep); until Result or (Rep = 0); // Cerrar... IcmpCloseHandle(hIcmpFile); WSACleanup; end; end.
Subo la unidad retocada para Lazarus y una pequeña aplicación de ejemplo.
Saludos.
#9
Escrito 29 noviembre 2011 - 06:19
#10
Escrito 30 noviembre 2011 - 12:59
Saludos.
#11
Escrito 02 diciembre 2011 - 06:51
Buenas amiguitos, resulta que lo he probado y siempre me sale "Fracaso" o sea como si no hubiera internet, que puede ser.....???
Les muestro el código:
unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Uping; type { TForm1 } TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Label1: TLabel; procedure Button1Click(Sender: TObject); private { private declarations } public { public declarations } end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject); begin {if Ping('[url=http://www.google.es]www.google.es[/url]') then Label1.Caption := 'Exito' else Label1.Caption := 'Fracaso';} //application.ProcessMessages; lo puse pensando que iba a trabajar mejor Label1.Caption := 'Haciendo ping...'; Label1.Update; if Ping(PCHAR(Edit1.Text)) then Label1.Caption := 'Exito' else Label1.Caption := 'Fracaso'; end; end.
Que puede ser....???
Gracias por sus comentarios.
#12
Escrito 02 diciembre 2011 - 07:48
Buenas amiguitos, resulta que lo he probado y siempre me sale "Fracaso" o sea como si no hubiera internet, que puede ser.....???
¿Tu conexión está detrás de un proxy?, en ese caso: ¿Leíste el enlace que te dí?
Si estás detrás de un proxy, puede ser que tengas que autentificarte, si no lo haces se rechazan los intentos de conexión a internet.
Saludos.
#13
Escrito 08 diciembre 2011 - 07:54
Buenas amiguitos y disculpen por la demora lo que pasa es que el viernes pasado asaltaron mi casa y se llevaron varias cosas incluyendo mi pc, , bueno en cuanto al programita parece parece que me funciona cuando pongo:
if Ping('[url=http://www.google.es]www.google.es[/url]') then Label1.Caption := 'Exito' else Label1.Caption := 'Fracaso';[/delphi] en vez de : [delphi]Label1.Caption := 'Haciendo ping...'; Label1.Update; if Ping(PCHAR(Edit1.Text)) then Label1.Caption := 'Exito' else Label1.Caption := 'Fracaso';
Bueno amiguitos seguiré probando y ahí les cuento, saludos......
PD: