Tester si vous êtes connecté au net

Télécharger le projet
Commenter

Description

Petit complément à un source présent içi.
Personnellement, j'ai l'ADSL, et connecté où non, le programme me répond toujours "Connecté".
Alors je vous propose une petite classe qui fait le tout, en vérifiant l'accès à certaines URL.

Source / Exemple : 


Option Explicit

' déclarations api wininet dll
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
    (lpdwFlags As Long, _
    ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal lpszAgent As String, _
    ByVal dwAccessType As Long, _
    ByVal lpszProxyName As String, _
    ByVal lpszProxyBypass As String, _
    ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
    (ByVal hInet As Long, _
    ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, _
    ByVal dwHeadersLength As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Long

' constante - indique utilisation de la config de la Base de Registre
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
' constantes - flags WinInet
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

' constantes - flags pour InternetGetConnectedState
Private Const INTERNET_CONNECTION_MODEM = 1
Private Const INTERNET_CONNECTION_LAN = 2
Private Const INTERNET_CONNECTION_PROXY = 4
Private Const INTERNET_CONNECTION_MODEM_BUSY = 8

' énumération des états de connection
Public Enum InetConnectionStates
   InternetConnectionModem = INTERNET_CONNECTION_MODEM
   InternetConnectionLan = INTERNET_CONNECTION_LAN
   InternetConnectionProxy = INTERNET_CONNECTION_PROXY
   InternetConnectionModemBusy = INTERNET_CONNECTION_MODEM_BUSY
End Enum

' variables privées
Private m_Connection         As Boolean
Private m_ModeConnection     As InetConnectionStates
Private m_ModeConnectionDesc As String
Private m_SitesConnus        As Collection

' initialisation
Private Sub Class_Initialize()
   Set m_SitesConnus = New Collection
   m_SitesConnus.Add "http://www.yahoo.com", "http://www.yahoo.com"
   m_SitesConnus.Add "http://www.cnn.com", "http://www.cnn.com"
End Sub
'
Private Sub Class_Terminate()
   Set m_SitesConnus = Nothing
End Sub

' propriétées publiques
Public Property Get TestSitesConnus() As Collection
   Set TestSitesConnus = m_SitesConnus
End Property

Public Property Let TestSitesConnus(ByVal NewVal As Collection)
   Set m_SitesConnus = NewVal
End Property

' propriétées publiques - en lecture seulement
Public Property Get Connected() As Boolean
   Connected = m_Connection
End Property
'
Public Property Get ConnectMode() As InetConnectionStates
   ConnectMode = m_ModeConnection
End Property
'
Public Property Get ConnectModeDesc() As String
   ConnectModeDesc = m_ModeConnectionDesc
End Property
'
Public Sub Actualiser()
   Dim Flags As Long
   m_Connection = InternetGetConnectedState(Flags, 0&)
   m_ModeConnection = Flags
   If Flags And INTERNET_CONNECTION_MODEM Then
      m_ModeConnectionDesc = "Modem"
      If Flags And INTERNET_CONNECTION_MODEM_BUSY Then
         m_ModeConnectionDesc = "Modem (Busy)"
         m_Connection = TestUrls()
      End If
   ElseIf Flags And INTERNET_CONNECTION_LAN Then
      m_ModeConnectionDesc = "LAN"
      m_Connection = TestUrls()
   ElseIf Flags And INTERNET_CONNECTION_PROXY Then
      m_ModeConnectionDesc = "Proxy Server"
      m_Connection = TestUrls()
   End If
End Sub
' méthodes privées

Private Function TestUrls() As Boolean
Dim hInet As Long
Dim hUrl  As Long
Dim Flags As Long
Dim url   As Variant
   ' On va tester les URLs, si on arrive à se connecter à un des sites
   ' le PC est bien connecté.
   hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
   If hInet Then
      Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
      For Each url In m_SitesConnus
         hUrl = InternetOpenUrl(hInet, CStr(url), vbNullString, 0, Flags, 0)
         If hUrl Then
            Call InternetCloseHandle(hUrl)
            TestUrls = True
            Exit For
         End If
      Next url
   End If
   Call InternetCloseHandle(hInet)
End Function

Conclusion :


A vous de choisir vos URLs, yahoo et cnn on été choisis car ce sont des sites rarement en panne.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Dr SKULL)