Comprobar conexión a internet.

[YAcosta]

Saludos
Necesito tener un label que me indique si tengo conexión a internet o no en tiempo real.
Encontré dos códigos. Usando un timer con interval a 500 probe con este código:

Código: (VB) [Seleccionar]

Option Explicit
'Funcion Api que obtiene información sobre el estado de Red
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
 
Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40
Private dwflags As Long
' Función Booleana para saber si se está conectado a internet
Private Function Online() As Boolean
   Online = InternetGetConnectedState(0&, 0&)
End Function

Private Sub Timer1_Timer()
If CBool(Online()) Then
   Label1 = "Conectados"
Else
   Label1 = "DesConectados"
End If
End Sub

Y funciona bien, me voy al router y desconecto el cable de poder y el label cambia a desconectado. Luego conecto el cable de poder y en un rato el estado cambia a conectado. Esto va bien. Probe luego con el segundo codigo el cual requiere un modulo:
Modulo:

Código: (VB) [Seleccionar]

Option Explicit
' Funciones Api
'''''''''''''''''''''''''''
Public Declare Function RasEnumConnections Lib "RasApi32.dll" _
    Alias "RasEnumConnectionsA" ( _
    lpRasCon As Any, _
    lpcb As Long, _
    lpcConnections As Long) As Long
 
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" _
    Alias "RasGetConnectStatusA" ( _
    ByVal hRasCon As Long, _
    lpStatus As Any) As Long
 
' constantes
''''''''''''''''''''''''''''''
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
 
' Estructuras
''''''''''''''''''''''''''''
Public Type RASCONN95
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
 
Public Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
       
Public Function Conectado() As Boolean
Dim TC(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim ret As Long
Dim Tstatus As RASCONNSTATUS95
    TC(0).dwSize = 412
    lg = 256 * TC(0).dwSize
 
    ret = RasEnumConnections(TC(0), lg, lpcon)
     
    If ret <> 0 Then
        MsgBox "error", vbCritical
        Exit Function
    End If
 
    Tstatus.dwSize = 160
    ret = RasGetConnectStatus(TC(0).hRasCon, Tstatus)
     
    'retorno
    If Tstatus.RasConnState = &H2000 Then
        Conectado = True
    Else
        Conectado = False
    End If
End Function

Formulario:

Código: (VB) [Seleccionar]

Private Sub Timer1_Timer()
    If Conectado Then
        Label1 = "Conectado"
    Else
        Label1 = "Desconectado"
    End If
End Sub
Y siempre me da Desconectado  ¿porque?, lei el código pero no logro entender porque no funciona este segundo codigo, ambos los saque de recursosvisualbasic.

Usare el primer codigo pero no queria quedarme con la duda de porque no funciona el segundo codigo.


Gracias

[th3y]

Hola, encontre algo acerca del segundo en este post:

http://www.vbforums.com/printthread.php?t=10198

Y segun dice un comentario, su uso es solo para Dial-up


Vi tambien este codigo para comprobar si tu conexion es por modem o lan:

Modulo:

Código: (VB) [Seleccionar]

Option Explicit
Public Declare Function InternetGetConnectedState _
Lib "wininet.dll" (ByRef lpSFlags As Long, _
ByVal dwReserved As Long) As Long

Public Const INTERNET_CONNECTION_LAN As Long = &H2
Public Const INTERNET_CONNECTION_MODEM As Long = &H1

Public Function ViaLAN() As Boolean

Dim SFlags As Long
'return the flags associated with the connection
Call InternetGetConnectedState(SFlags, 0&)

'True if the Sflags has a LAN connection
ViaLAN = SFlags And INTERNET_CONNECTION_LAN

End Function
Public Function ViaModem() As Boolean

Dim SFlags As Long
'return the flags associated with the connection
Call InternetGetConnectedState(SFlags, 0&)

'True if the Sflags has a modem connection
ViaModem = SFlags And INTERNET_CONNECTION_MODEM

End Function
Formulario con 2 textbox y un command button

Código: (VB) [Seleccionar]

Option Explicit

Private Sub Command1_Click()
Text1 = "Conexion Lan :" & ViaLAN()
Text2 = "Conexion Modem :" & ViaModem()
End Sub


[YAcosta]

Retomo el tema porque se me presento un problema que por poco me deja mal.

Usando este codigo checo unos enlaces a internet

Código: (VB) [Seleccionar]

'------ para la conexión a internet ------------------
Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Public Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8
Public Const INTERNET_RAS_INSTALLED As Long = &H10
Public Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Public Const INTERNET_CONNECTION_CONFIGURED As Long = &H40
'---------------------------------------------------------------

Public Function HayInternet() As Boolean
   HayInternet = InternetGetConnectedState(0&, 0&)
End Function


Código: (VB) [Seleccionar]

Private Sub LeyendoEnlaces()
If HayInternet Then
   Dim hOpen As Long, hFile As Long, sBuffer As String, ret As Long
   sBuffer = Space(1000)           
   hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) 'Aqui se me cuelga
   hFile = InternetOpenUrl(hOpen, sUrl, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)    'Open the url
   InternetReadFile hFile, sBuffer, 1000, ret           
   InternetCloseHandle hFile                             
   InternetCloseHandle hOpen
   ...
   ...
   ...
End Sub

Entonces sucede lo siguiente.
1.- Cuando el aplicativo corre en una PC conectada a un router y el router esta apagado la función HayInternet me devuelve False y no hace nada con internet saliendo hacia otros procedimientos. Todo perfecto. Si la función devuelve True entonces lee unos enlaces los cuales manipulo. Esto lo probé en mi PC y ejecuto perfecto, lo lleve a 4 clientes y todo muy bien, Ojo que todos esos 4 clientes usan el aplicativo en red.

2.- Pero el sabado en un quinto cliente el aplicativo empezó a colgarse, abro un browser y no había internet, el router estaba prendido y bien conectado, conclusión el proveedor no le daba internet pero... ¿porque se cuelga mi aplicativo?, me voy al codigo y veo la funcion HayInternet me sigue devolviendo True... entonces concebí mal esa funcion ya que esta no me verifica si hay internet o no, creo que me verifica si estoy conectado a la red o no.... Para salir del paso apague esas funciones y el cliente pudo andar.

3.- Llegue a mi casa y volvi a probar y todo funcionaba bien, ahora abro una maquina virtual y alli levanto el aplicativo. La maquina virtual se alimenta del internet de la PC host. El aplicativo tambien corre bien, la funcion entrega True. Apago el router, naturalmente la red del host sale como desconectada pero no la red de la PC virtual. Levanto el aplicativo y nuevamente se cuelga, la función me sigue dando true. Luego si sigo se me cuelga en hOpen = InternetOpen(scUserAgent,.....

¿Como podria hacer para resolver esto? la función que uso al parecer solo me da true o false si el router esta prendido y conectado directamente a la pc ¿? no capto este tema. ¿Que otra consulta o funcion debo agregar?

Muchas Gracias.

[LeandroA]

Hola Yvan es medio chivo ese tema fijate que hasta los navegadores se toman su tiempo, la diferencia es que estos no se cuelgan, por lo que pude ver lo mejor que encontre hasta el momento es con el api InternetCheckConnection , esta se demora uno 11 segundo aproximadamente (si es que no hay internet), colgar se va a colgar, pero bueno, tuvieras que chekear almenos una url, si esta falla es casi un 99% de que no hay internet. y en ese caso no haces mas las consultas que mencionas.

por cierto No es InternetOpen el que produce el cuelgue, es  InternetOpenUrl

ejemplo de InternetCheckConnection

Código: (VB) [Seleccionar]

Private Const FLAG_ICC_FORCE_CONNECTION = &H1
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Sub Form_Load()
    'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    If InternetCheckConnection("http://www.allapi.net/", FLAG_ICC_FORCE_CONNECTION, 0&) = 0 Then
        MsgBox "Connection to http://www.allapi.net/ failed!", vbInformation
    Else
        MsgBox "Connection to http://www.allapi.net/ succeeded!", vbInformation
    End If
End Sub
por hay te combiene poner un cartel de espera antes de chequear la coneccion, para que no parezca que se cuelga el programa.

[LeandroA]

otra forma pero tiene una buena y una mala, la buena es que no cuelga el programa, la mala es que tarda mucho, pero si te das un poco de maña, lo haces con un timer en en segundo plano, no se cual es la forma en que vos vas haciendo las consultas, pero bueno, son casos especiales. ademas vos no tenes la culpa de que a tu cliente no le ande internet XD

Código: (VB) [Seleccionar]

Option Explicit

Private Sub Form_Load()
    MsgBox CheckConnection("http://www.google.com/")
End Sub


Public Function CheckConnection(sURL) As Boolean
  Dim xml As Object
  Set xml = CreateObject("Microsoft.XMLHTTP")
  xml.Open "GET", sURL, True
  xml.Send

  Do While xml.readyState <> 4
    DoEvents
  Loop

  CheckConnection = CBool(xml.Status = 0)
  Debug.Print xml.Status
  Set xml = Nothing
End Function


[YAcosta]

Muchas gracias Leandro por el apoyo.... esto ultimo que acabas de comentar me interesa muchisimo, porque lo de la buena (que no se cuelga me interesa) y lo de la mala que se tarda mucho... +/- ¿cuanto es mucho?... incluso si tarda cinco minutos no me hace problema. Mi sistema lo usan todo el dia, y lo que yo cargo en un unImage son una imagenes publicitarias de otros servicios que brindo y tambien les aviso de una nueva version, estas imagenes yo las ponto en mi host y las rutas a esas imagenes los tengo en un archivo de texto tambien en el host. Cargo el archivo de texto, leo las direcciones y muestro las imagenes en ratios de 1 minuto cada una. Que empiece a hacer esto al minuto o a los 5 minutos de que inician el programa no me afecta siempre que no se les cuelgue. Hasta ahora me funcionó y ante esa eventualidad queria estar preparado.

Cierto me equivoque en la linea donde se cuelga.

Voy a probar este ultimo código que publicaste, gracia amigo.

[YAcosta]

He aplicado el codigo donde preguntamos por google.com, trabajando en la maquina virtual, no se porque cuando apago el router y lo vuelvo a enchufar y espero sigue asumiendo que estamos desconectados. En un momento cerre el VB6 y al volver entrar me reconocio, volvi a hacer la operacion de apagar y prender y cerrar VB6 y hasta ahora asume desconectado.

Cuando estamos desconectados en la parte de Do While xml.readyState <> 4 entra a un loop infinito que logicamente no me cuelga el programa por el DoEvents, pero preferi poner un limite que si despues de 500 vueltas no da valor es que no hay internet y salga del loop con el mensaje de que no hay internet. Entonces el codigo me va quedando asi:

Código: (VB) [Seleccionar]

Dim ciclos As Integer
Option Explicit
 
Public Function CheckConnection(sURL) As Boolean
  Dim xml As Object
  Set xml = CreateObject("Microsoft.XMLHTTP")
  xml.Open "GET", sURL, True
  xml.Send
 
  Do While xml.readyState <> 4 'cuando no hay internet este loop se hace infinito
    DoEvents
    ciclos = ciclos + 1
    If ciclos = 500 Then   'No se si 500 sea muy poco lo cierto es que lo realiza casi de inmediato
      CheckConnection = False
      ciclos = 0
      Set xml = Nothing
      Exit Function
    End If
  Loop
 
  CheckConnection = CBool(xml.Status = 0)
  Set xml = Nothing
End Function

Private Sub Timer1_Timer()
If CheckConnection("http://www.google.com/") Then
   Label1 = "Hay Internet"
Else
   Label1 = "No Hay Internet"
End If
End Sub

Sucede que se queda como "pegado" porque siempre me termina saliendo "No hay Internet" a pesar de que si hay internet. ¿porque puede estar pasando esto?

Gracias

[YAcosta]

Algo no estoy destruyendo bien? o algo falta inicializar? porque cuando lo ejecute la primera vez si me salio Hay Internet... luego ya no.
[youtube]http://www.youtube.com/watch?v=-235mH0eyN4[/youtube]

El aplicativo tiene 5 minutos levantado y aun el codigo del timer no detecta la presencia del internet.

[E N T E R]

Encontre este codigo, tarda como 8 a 10 segundos. para actualizar el estado dale click como 4 5 veces al boton y a ver que tal.

Código: (VB) [Seleccionar]

Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long

Public Function CheckInternetConnection() As Boolean
    Dim aux As String * 255
    Dim r As Long
    r = InternetGetConnectedStateEx(r, aux, 254, 0)
    If r = 1 Then
        CheckInternetConnection = True
    Else
        CheckInternetConnection = False
    End If
End Function

Private Sub Command1_Click()
    If (CheckInternetConnection = True) Then
        MsgBox "si!"
    Else
        MsgBox "no"
    End If
End Sub

[YAcosta]

Gracias Enter. Pero lamentablemente no funciono para mis propositos.
Te muestro el escenario. Estando dentro de una Maquina Virtual con internet y cambiando el codigo del comand1 a un timer y que me avise mediante un label:

1.- Ejecute y reconocio internet. Mensaje en label "Hay Internet", bien alli.
2.- Deshabilite la conexion de red de la maquina virtual en caliente y el programa cambio a "No Hay internet". Bien hasta aqui.
3.- Habilite en caliente y el programa respondio: "Hay Internet", bien alli.
4.- Teniendo el programa abierto fui al router y lo apague... el programa seguia con "Hay Internet"
5.- Cerre el programa porque quiza InternetGetConnectedStateEx necesita ser reiniciado.
6.- Abri el programa nuevamente y siguio dando "Hay internet" teniendo el router aun apagado.

No se me colgo en ningun momento pero no me esta dando la informacion que necesito, parece que ese codigo checa si la red esta habilitida no si hay presencia de internet, me parece.


P.D: La web de tu firma ya no existe, considera cambiarla o usa un wordpress aunque el nombre de dominio cambiaria a www.enterpy.wordpress.com lo haces una vez y te olvidas para siempre sin necesidad de mantenerlo.

[E N T E R]

A ver este creo que funciona como quieres. Apague y prendí el router y lo hace bien.

Código: (VB) [Seleccionar]

Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Private Const CONNECT_LAN As Long = &H2
Private Const CONNECT_MODEM As Long = &H1
Private Const CONNECT_PROXY As Long = &H4
Private Const CONNECT_OFFLINE As Long = &H20
Private Const CONNECT_CONFIGURED As Long = &H40

Public Function IsWebConnected(Optional ByRef ConnType As String) As Boolean
   
    Dim dwflags As Long
    Dim WebTest As Boolean
    ConnType = ""
    WebTest = InternetGetConnectedState(dwflags, 0&)
   
    Select Case WebTest
        Case dwflags And CONNECT_LAN: ConnType = "LAN"
        Case dwflags And CONNECT_MODEM: ConnType = "Modem"
        Case dwflags And CONNECT_PROXY: ConnType = "Proxy"
        Case dwflags And CONNECT_OFFLINE: ConnType = "Offline"
        Case dwflags And CONNECT_CONFIGURED: ConnType = "Configured"
        Case dwflags And CONNECT_RAS: ConnType = "Remote"
    End Select
   
    IsWebConnected = WebTest
   
End Function

Private Sub Timer1_Timer()
    Dim msg As String
    If IsWebConnected(msg) Then
        Picture1.BackColor = vbGreen
    Else
        Picture1.BackColor = vbRed
    End If

End Sub

[LeandroA]

esa la de poner una comprobante de ciclos es buena, pero no de esa forma, 500 ciclos es prácticamente nada, no da tiempo a conectar lo mejor es manejarse con tiempo en segundos ya que los ciclos según la pc pueden variar
mira de esta forma le doy un tiempo de 5 segundos, vos si queres dale menos.

Código: (vb) [Seleccionar]


Option Explicit
 
Public Function CheckConnection(sURL) As Boolean
  Dim xml As Object
  Dim lTime As Long
  Set xml = CreateObject("Microsoft.XMLHTTP")
  xml.Open "GET", sURL, True
  xml.Send
 
 
  lTime = Timer
  Do While xml.readyState <> 4
    DoEvents
 
    If lTime + 5 < Timer Then '5 Segundos de espera
      CheckConnection = False
      Set xml = Nothing
      Exit Function
    End If
  Loop
 
  CheckConnection = CBool(xml.Status = 0)
  Set xml = Nothing
End Function
 
Private Sub Timer1_Timer()
    If CheckConnection("http://www.google.com/") Then
       Label1 = "Hay Internet"
    Else
       Label1 = "No Hay Internet"
    End If
End Sub


ojo el timer dale mas de 5 segundos de vueltas sino es como que se juntan.

[YAcosta]

A ver este creo que funciona como quieres. Apague y prendí el router y lo hace bien.

Código: (VB) [Seleccionar]

Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Private Const CONNECT_LAN As Long = &H2
Private Const CONNECT_MODEM As Long = &H1
Private Const CONNECT_PROXY As Long = &H4
Private Const CONNECT_OFFLINE As Long = &H20
Private Const CONNECT_CONFIGURED As Long = &H40

Public Function IsWebConnected(Optional ByRef ConnType As String) As Boolean
   
    Dim dwflags As Long
    Dim WebTest As Boolean
    ConnType = ""
    WebTest = InternetGetConnectedState(dwflags, 0&)
   
    Select Case WebTest
        Case dwflags And CONNECT_LAN: ConnType = "LAN"
        Case dwflags And CONNECT_MODEM: ConnType = "Modem"
        Case dwflags And CONNECT_PROXY: ConnType = "Proxy"
        Case dwflags And CONNECT_OFFLINE: ConnType = "Offline"
        Case dwflags And CONNECT_CONFIGURED: ConnType = "Configured"
        Case dwflags And CONNECT_RAS: ConnType = "Remote"
    End Select
   
    IsWebConnected = WebTest
   
End Function

Private Sub Timer1_Timer()
    Dim msg As String
    If IsWebConnected(msg) Then
        Picture1.BackColor = vbGreen
    Else
        Picture1.BackColor = vbRed
    End If

End Sub

Doc, dame el mismo problema de siempre, desconecto y sigue apareciendo conectado (o en verde en tu codigo). El problema es que tu estas probando con una conexion directa y no desde una maquina virtual. Con conexion directa o en red todos los codigos me funcionan, pero no desde una maquina virtual para simular lo que me sucede con el cliente del problema.

Ahora voy a ver el codigo de Leandro

[E N T E R]

Es desde una maquina virtual amigo

[YAcosta]

Leandro, se redujo bastante los inconvenientes, pero aun sigue un pequeño inconveniente, no muy grave pero inconveniente al fin, permíteme mostrarte este vídeo de 7 minutos para explicarte mejor el tema.
[youtube]http://www.youtube.com/watch?v=bajUAAxf8hY[/youtube]