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

Du même auteur (Dr SKULL)