Tester si une connection internet existe

Soyez le premier à donner votre avis sur cette source.

Vue 9 449 fois - Téléchargée 728 fois

Description

TstNet permet d'envoyer un mail si connection existe
sinon un code d'erreur vous dit que vous n'êtes pas connecté
on peut aussi lancer la messagerie par défaut
ou /et appeler un site
les 2 autres fichiers ( ne sont pas de moi )
MsTools est un AddIn pour VB trés bien
IndenterVB5.exe est un AddIn pour VB trés bien
salut à tous

Source / Exemple :


Option Explicit
'La suite se trouve dans le ZIP dont le module mTestNet.bas
Dim NomUtilisateur$
Dim NomServeurSMTP$
Dim MotDePasse$
Dim AdressDestinataire$
Dim AdressExpediteur$
Dim AdressCopy$
Dim HommeInvisible$
Dim PieceJointe$
Dim Message$

Dim TypeConnect$
'============================
Private Sub cmdSiteJpf_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdSiteJpf_Click
' DateTime  : 28/08/2004 11:28
' Author    : jean-paul
' Purpose   :
'---------------------------------------------------------------------------------------
Dim Foo As String
Dim bconnecter_net As Boolean
Dim iRc%

iRc = ComposemailTest
'if irc=1 thern 1 message envoye
'if irc=2 thern 1 message envoye mais pas trouvé la piece à joindre

If iRc < 0 Then
    MsgBox "Vous n'avez pas de connection permanente Internet"
    TypeConnect = ""
    End
Else
    MsgBox " Votre Connection Internet est active "
    TypeConnect = "PERMANENT"
    Foo = ShellExecute(hWnd, "Open", "http://perso.wanadoo.fr/jean-paul.faidherbe", "", "", 1)
End If
End Sub

'===========================
Private Function ComposemailTest() As Integer
'---------------------------------------------------------------------------------------
' Procedure : ComposemailTest
' DateTime  : 28/08/2004 10:46
' Author    : jean-paul
' Purpose   :tente l'envoi d'un email pour savoir si connection Internet valide
'---------------------------------------------------------------------------------------
Dim A(10) As String
Dim Rc%, I%
Dim Fichier As String
Dim dummy As String
Dim LigneMessage$
Dim strMessage$
Dim MyFile As String
Dim iMsg As New CDO.Message
Dim iConfig As New CDO.Configuration
Dim Champs As ADODB.Fields

 
 Set Champs = iConfig.Fields
 With Champs
 .Item(cdoSendUsingMethod) = cdoSendUsingPort
 .Item(cdoSMTPServer) = NomServeurSMTP '"smtp.wanadoo.fr"
 .Item(cdoSMTPConnectionTimeout) = 10
 .Item(cdoSMTPAuthenticate) = cdoBasic
 .Item(cdoSendUserName) = NomUtilisateur
 
 .Item(cdoSendPassword) = MotDePasse   ' "jp050738"
 .Item(cdoURLProxyServer) = "server:80"
 .Item(cdoURLProxyBypass) = "<local>"
 .Item(cdoURLGetLatestVersion) = True
 End With
' Maintenant le message lui meme
 With iMsg
    Set .Configuration = iConfig
    .To = AdressDestinataire
    .From = AdressExpediteur ' "jean-paul.faidherbe@wanadoo.fr"
    .Subject = App.EXEName & "_" & PieceJointe & "_" & Format(Now, "dd/mm/yyyy")

ENVOI:
' ajouter les infos diverses
        strMessage = strMessage & "DE_:  " & AdressExpediteur & vbCrLf
        strMessage = strMessage & "A__ :  " & AdressDestinataire & vbCrLf
        strMessage = strMessage & "CC_:" & AdressCopy & vbCrLf
        strMessage = strMessage & "CCI:" & HommeInvisible & vbCrLf
    .TextBody = strMessage
    On Error GoTo ERR_CDO
    '------------------------------ENVOYER tous les ZIP de CheminExport
    MyFile = Dir(App.Path & "\*.bas", vbNormal)
      Do While MyFile <> ""  ' Commence la boucle.
        .AddAttachment App.Path & "\" & MyFile
        MyFile = Dir
      Loop
'    Call AfficheMsg("Envoi du Mail en cours ", -1)
    On Error GoTo ERR_CDO
    '    send sans parametre  FALSE on peut mettre true
    .Send
 End With
  ' quand on arrive ici est-ce  envoyé   ????????
  
  ComposemailTest = 1
 
 Exit Function

'' quand on arrive ici c'est pas encore envoyé
ERR_CDO:
     If Err.Number = -2147024891 Then ' cdoE_NO_ACCESS hex( -2147024891 )=80070005
             Resume Next        ' attendre
     ElseIf Err.Number = -2147220973 Then   ' hex( -2147220973)=8004 0213 ou 1531
          Message = Err.Description & " " & "pas de connection valide"
        MsgBox Message, vbCritical
        ComposemailTest = -1
         Exit Function
     Else
        MsgBox Err.Number & vbCrLf & Err.Description
        ComposemailTest = -1
     End If
Exit Function
PasDeFichier:
      MsgBox App.Path & "Pas de Fichier !!!" & Fichier, vbCritical
      ComposemailTest = 2
      Exit Function
End Function

'=============================
Public Sub VBHref(strURL As String)
    '=============================
    Dim Foo As String
    Foo = ShellExecute(hWnd, "Open", strURL, "", "", 1)
End Sub
'==========================
Private Sub cmdMail_Click()
'==========================
    
        VBHref "mailto:" & AdressDestinataire & "?subject=" & PieceJointe
    
End Sub

Private Sub cmdFermer_Click()

    End

End Sub
'==========================
Private Sub Form_Load()
'==========================
 ' login du compte chez la FAI   NomUtilisateur="fti/abcde6k"
 '  MotDePasse                          "*******"
 '  smtp.wanadoo.fr                    NomServeurSMTP
 '  jean.toto@wanadoo.fr            adresse du destinataire
 '  jules.butte@wanadoo.fr          adresse expediteur
 
 NomUtilisateur = "fti/xxxxxxk"
 NomServeurSMTP = "smtp.wanadoo.fr"
 MotDePasse = "mmmmmm"
AdressDestinataire = "jipef@wanadoo.fr"
AdressExpediteur = "jipef@wanadoo.fr"
AdressCopy = AdressDestinataire ' "moi@wanadoo.fr"
HommeInvisible = AdressDestinataire '  "moncopain@wanadoo.fr"
PieceJointe = App.Path & "\mTestNet.bas"

End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_jipef
Messages postés
56
Date d'inscription
lundi 23 août 2004
Statut
Membre
Dernière intervention
1 août 2008
-
je viens de trouver le code de CaniLupus c'est excellent et je l'ai intégré de suite
je cherche un moyen simple de tester si j'ai des messages qui sont arrivés avec un sujet de mon choix
actuellement je fais avec WinDev mais çca ne me plait pas dans la mesure où mon applic est en VB6

a vous lire
Ze_Dam
Messages postés
340
Date d'inscription
lundi 8 mars 2004
Statut
Membre
Dernière intervention
7 juillet 2005
-
nom de dieu mais quel code de fous pour tester si on est connecté à internet ou pas. il faut utiliser la bonne api et tout va bien les gars

Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long

If InternetGetConnectedState(0&, 0&) Then
MsgBox "Vous êtes connecté à Internet" Else
MsgBox "Vous n'êtes pas connecté à Internet"

Et voilà elle est pas plus belle la vie ??????
cs_CanisLupus
Messages postés
3758
Date d'inscription
mardi 23 septembre 2003
Statut
Modérateur
Dernière intervention
13 mars 2006
10 -
Sauf qu'en entreprise, Ze_Dam, InternetGetConnectedState te renvoie vrai même si tu n'as qu'un intranet sans accès réel internet. J'ai testé chez moi et, même avec la freebox débranchée, ton API me dit que je suis connecté à Internet (faut dire aussi que j'ai un réseau local).
Autre exemple, dans ma boîte, tout le monde a une adresse e-mail ouverte sur l'extérieur et a accès à l'intranet mais seuls quelques uns ont un véritable accès Internet (c à d vers l'extérieur de la boîte). C'est le proxy qui gère ça. Donc, pour savoir si un PC peut se connecter ou non à l'Internet, j'avais trouvé le code suivant avec un composant Inet.

' ----------------------------------
' DETECTION SI ACCES INTERNET VALIDE
' ----------------------------------
Function Acces_Internet() As String
Dim ret

Acces_Internet = "KO"

On Error Resume Next

Form1.Inet1.AccessType = icUseDefault
Form1.Inet1.OpenURL "http://www.microsoft.com"
ret = Form1.Inet1.GetHeader("Server")
Form1.Inet1.Cancel

If InStr(1, ret, "Microsoft", 1) Then
Acces_Internet = "OK"
End If

End Function

Je pense que c'est de ça dont s'est inspiré jipef. Le principe est simple, on tente de lire le header d'un site Internet (tu peux prendre autre chose que Microsoft, par ex vbfrance, quoiqu'il faut savoir ce qu'il y a dans le header). C'est tout bête, si le serveur te répond tu as un accès à ce serveur sinon tu es unplug. Ca fait 2/3 lignes de code de plus que l'API mais c'est plus fiable.

Tiens, je mets un 10, pas parce que jipef m'a cité mais parce qu'il en a trouvé une utilisation intéressante.
Ze_Dam
Messages postés
340
Date d'inscription
lundi 8 mars 2004
Statut
Membre
Dernière intervention
7 juillet 2005
-
dans ces cas là oui, en effet, l'API que j'utilise n'a aucune utilité. Mais pour un particulier, pas de réseau, d'intranet, l'API fonctionne très bien et se fait aussi très discrette dans le code. Mais une petite question, ne serait-ce pas mieux de pointer sur un site Web moins occupé, mais dont ôn est sûr qu'il reste là pourtant. Je m'explique, se connecter sur un site plus charger (tel vbfrance) serait ptet plus lent que de se connecter sur un plus petit site ??? ou je me goure complètement ???
cs_CanisLupus
Messages postés
3758
Date d'inscription
mardi 23 septembre 2003
Statut
Modérateur
Dernière intervention
13 mars 2006
10 -
Ben non, Ze_Dam, tu ne te gourres pas. L'essentiel est que le site ne change pas trop souvent d'hébergeur et qu'il ait un bon temps de réponse. Cela n'est pas forcément lié à l'importance du site et/ou à sa fréquentation mais plutôt avec sa capacité à gérer un grand nombre de connexions simultanées. C'est pourquoi j'ai choisi microsoft.com mais tu peux choisir un des principaux FAI ou n'importe quel autre hébergeur.
En cas de problème, on peut même insérer un test au cas où le header du serveur change.
Comme ce code fonctionne depuis déjà un bon moment avec succès (près de 4 ans), je n'ai pas jugé utile de trouver une autre solution. Mais, j'imagine qu'une adaptation du PING (sous dos) peut être envisageable.

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.