Tester si une connection internet existe

Soyez le premier à donner votre avis sur cette source.

Vue 9 514 fois - Téléchargée 740 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

Messages postés
17
Date d'inscription
mercredi 10 mars 2004
Statut
Membre
Dernière intervention
21 mars 2006

Moi ta source ne me sert pas, mais j'aime bien ton style d'écriture. C'est clair, ya des "pouets-pouets" pour faire jolie et aérré le code, pis ya pas mal de commentaire.

Pour ça, chte met 8 !
Messages postés
3757
Date d'inscription
mardi 23 septembre 2003
Statut
Modérateur
Dernière intervention
13 mars 2006
14
Merci pour le lien, jipef, j'ai peut-être survolé sans m'y arrêter mais maintenant, je vais étudier la question à fond, des fois que ça me facilite la vie !
Messages postés
55
Date d'inscription
lundi 23 août 2004
Statut
Membre
Dernière intervention
1 août 2008

Messages postés
33
Date d'inscription
mercredi 26 mars 2003
Statut
Membre
Dernière intervention
1 mars 2005

L'envoi d'un email-test par CDO est intéressante : ça marche avec n'importe quels nom de serveur, adresses expéditeur et destinataires bidons !!!!
Et le temps de réponse me semble plus rapide que de tester un lien URL.
Mais question : comment fonctionne ce composant CDO ?
--> La propriété "cdoSMTPServer" de l'objet CDO.Configuration est
http://schemas.microsoft.com/cdo/configuration/smtpserver
--> on lui donne une valeur n'importe laquelle
--> qu'est-ce que bricole alors microsoft ????
Messages postés
340
Date d'inscription
lundi 8 mars 2004
Statut
Membre
Dernière intervention
7 juillet 2005

petite correction dans la formule que je donne If InternetGetConnectedState(0&, 0&) etc (voir plus haut), eh ben certain ont une erreur de compilation sur cette formule, il faut dans ce cas supprimer (0&, 0&) pour régler le problème
Afficher les 18 commentaires

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.