Checkeur de mail (avec winsock) maj!!!

Soyez le premier à donner votre avis sur cette source.

Vue 6 424 fois - Téléchargée 856 fois

Description

Sert à vérifie si on a des messages dans sa BAL sans pour autant les télécharger
G fait le prog pas trop compliqué pour que ce soit facile d'accès et pour montrer un peu l'utilisation de winsock avec le protocole pop3, si ca marche pas prévenez moi

Maj03/02 Ajout progress bar + info sur taille + bug deco/reco fixé

Source / Exemple :


'   Checkeur de Mail
'   Il faut rentrer son serveur pop dans la constante SERVEUR juste en dessous
'   Pour ceux qui comprennent pas trop voilà un exemple:
'   consulter l'adresse rep@wanadoo.fr sachant que le mdp est prout
'   on met dans la variable SERVEUR : "pop.wanadoo.fr"
'   dans l'appli on met dans user: rep
'   et dans Mot de passe: prout
'   ensuite on appuie sur go
'
'   Mon but étant de montrer l'utilisation de winsock sur le protocole pop3
'   G pas poussé les capacités de l'appli mais rien ne vous en empeche ...

Private Type Info
    nb As String
    taille As String
End Type

Const SERVEUR = "" '<--------------------- Serveur par défaut

Dim étape As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Déclaration pour le checker-mail '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const CONNEX = 1
Const USER = 2
Const PASS = 3
Const STAT = 4

Private Sub B_GO_Click()
On Error Resume Next
Dim ret
    If Not Text1.Text = "" And Not Text2.Text = "" And Not Text3.Text = "" Then
        étape = CONNEX
        W.RemoteHost = Text3.Text
        W.Close
        DoEvents
        W.Connect
    Else
        ret = MsgBox("Vous devez remplir les 3 champs: [Serveur] [Login] et [Mot de passe]", vbCritical)
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then Text2.SetFocus
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then Call B_GO_Click
End Sub

Private Sub W_DataArrival(ByVal bytesTotal As Long)
    Dim ret
    Dim Temp As String
    Dim temp1 As Info
    W.GetData Temp, vbString
    If Mid(Temp, 1, 1) = "+" Then 'le debut d'un message d'accord, changer si ce n'est pas le K pour votre serveur
        Select Case étape
        Case CONNEX
            ProgressBar.Value = 10
            Envoyer ("USER " & Text1.Text)
            ProgressBar.Value = 20
        Case USER
            ProgressBar.Value = 30
            Envoyer ("PASS " & Text2.Text)
            ProgressBar.Value = 40
        Case PASS
            ProgressBar.Value = 50
            Envoyer ("STAT")
            ProgressBar.Value = 60
        Case STAT
            ProgressBar.Value = 70
            temp1 = Récupération(Temp)
            If Val(temp1.nb) > 0 Then
                ret = MsgBox(temp1.nb & " Nouveau(x) Message(s)  " & vbCrLf & "Pour :   " & temp1.taille, , "Alors? Combien?")
            Else
                ret = MsgBox("Désolé, pas de message", , "Snif")
            End If
            DoEvents
            Envoyer ("QUIT")
            'rien ne vous empeche d'appeller votre outlook suivant la réponse de la box...
        Case Else
        End Select
        étape = étape + 1
    Else
        ret = MsgBox("Erreur: " & Temp, vbOKCancel + vbCritical, "Arg")
        DoEvents
        Envoyer ("QUIT")
    End If
End Sub

Private Sub W_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
''''''''''''''''' Souvent C1 probleme de port
    Dim ret As Integer
    W.Close
    DoEvents
    ret = MsgBox(Description & vbCrLf & "On passe au port suivant?", vbCritical + vbOKCancel)
    If ret = vbOK Then
        W.Close
        W.LocalPort = W.LocalPort + 1
        étape = CONNEX
        W.Connect
    End If
    DoEvents
    ProgressBar.Value = 0.0001
End Sub

Function Envoyer(Temp As String)
'''''''''''''''''''' Le but est d'envoyer lettre par lettre
Dim i, max
max = Len(Temp)
For i = 1 To max Step 1
    W.SendData (Mid(Temp, i, 1))
Next i
W.SendData (vbCrLf)
End Function

Private Function Récupération(Temp As String) As Info
'''''''''''''''''''' Permet de récup le nbre de message
'''''''''''''''''''' Quand trouvé est vrai c'est qu'on a trouvé le premier espace
'''''''''''''''''''' Donc quand on trouve le 2eme on a délimité le nbre de message
    Dim lon, deb, i, tail
    Dim Reponse As Info
    Dim trouvé As Boolean
    trouvé = False
    lon = Len(Temp)
    For i = 1 To lon Step 1
    If Mid(Temp, i, 1) = " " Then
        If Not trouvé Then
            deb = i: trouvé = True
        ElseIf trouvé Then
''''''''''''''''''''' On a trouvé la fin et on renvoie la string comportant le nbre de msg
            Reponse.nb = Mid(Temp, deb, i - deb)
''''''''''''''''''''' Maintenant c'est la taille
''''''''''''''''''''' Important: La taille donnée est la taille du/des msg sur le serveurs
''''''''''''''''''''' ce qui ne correpond pas vraiment à la taille des pieces jointes sachant
''''''''''''''''''''' le msg sur le serveur contient des infos supplémentaire qui nous sont
''''''''''''''''''''' cachées par Outlook pour des raisons de lisibilité
''''''''''''''''''''' Pour résumer la taille affichée par la pop-up correspond à ce que vous avez
''''''''''''''''''''' besoin de télécharger pour réccup le msg
            tail = Val(Mid(Temp, i + 1, lon - i - 2) / 1024)
            Select Case tail
            Case 0 To 1024 'en K
                tail = Format(tail, "0.##")
                Reponse.taille = Str(tail) & " Ko"
            Case Is > 1024
                tail = Format(tail / 1024, "##0.00")
                Reponse.taille = Str(tail) & " Mo"
            End Select 'on prend pas en compte le cas ou c'est inférieur à 4 car c'est qu'il n'y a pas de msg et donc on affichera pas la taille
            Récupération = Reponse
            Exit Function
        End If
    End If
    Next i
End Function

Private Sub Form_Load()
    Text3.Text = SERVEUR
    ProgressBar.Value = 0.0001
    W.LocalPort = 669
    W.RemotePort = 110  'le port utilisé pour le protocole pop3, ne pas le changer
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
lundi 14 août 2006
Statut
Membre
Dernière intervention
1 novembre 2009

Bonjour,
Félicitation pour ton prog!
Simple mais éfficace...
J'ai juste une question:
pourquoi est ce que les numéros de port de sont-ils différents de ceux fournis par yahoo?
J'ai ramer dessus pendant des jours (avec les numero de port indiqué par yahoo:http://popfwd.mail.yahoo.com/pf/PopConfig?.intl=fr&.addr=&.bm= )
Comment ça se fait que ça fonctionne?
Messages postés
26
Date d'inscription
mardi 21 novembre 2000
Statut
Membre
Dernière intervention
17 novembre 2007

Pas mal ces sources !

Mais comment on fait pour les mail genre GMail ???
Ils requierent une connexion sécurisée SSL (This server requires a secure connection (SSL)) et "My server requires authentication"
Messages postés
56
Date d'inscription
lundi 23 août 2004
Statut
Membre
Dernière intervention
1 août 2008

c'est trés bien 9/10
je souhaite
lire l'objet du mail afin de ne retirer que ceux ayant l'objet que j'attends avec les pieces jointes

a tu une solution, ou quelles sont les autres commandes Winsock qui le permettent , ensuite j efface les messages que j'ai prélevé
Les autres mails restent donc sur le serveur
Messages postés
5
Date d'inscription
samedi 29 juin 2002
Statut
Membre
Dernière intervention
15 août 2002

Repie> voila g un pti probleme assez long a expliquer je t'ai envoyer un message essaye deme repondre :)
Messages postés
103
Date d'inscription
mardi 10 octobre 2000
Statut
Membre
Dernière intervention
5 mars 2006

liberasoft> bah en fait j'avais vu un truc dessus, avec ta configuration d'outlook(si tu tlcharges tes mails avec outlook...) tu as une option qui permet de laisser les messages sur le serveur et comme ca si tu vrifies tes mails d'autre part que chez toi, bah tu effaces pas les messages et tu peux les reprendre de chez toi.
Les mails restent donc sur le serveur et C l'appli qui se souvient avoir tlcharg certains (je C pas comment ca par contre).
Afficher les 10 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.