Checkeur de mail (avec winsock) maj!!!

Soyez le premier à donner votre avis sur cette source.

Vue 6 395 fois - Téléchargée 843 fois

Télécharger le projet
Commenter

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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_joker
Messages postés
49
Date d'inscription
vendredi 11 janvier 2002
Statut
Membre
Dernière intervention
20 juillet 2004
 -
Pour les tests, ça marche sur club internet et netcourrier ... et même sur l'email sécurisé de ma boite ... simple mais efficace
je mettrais bien 8/10, mais j'sais pas comment on vote ici ?!
Signaler
cs_thebigbang
Messages postés
196
Date d'inscription
vendredi 21 décembre 2001
Statut
Membre
Dernière intervention
25 juillet 2006
 -
Pour voter :

Tu cliques sur le "+" juste dans la barre en haut de ton message ...Tu regardes tout à droite de cette barre ... Et tu y cliques dessus ... Une sorte de fenêtre se déroule et la tu choisis la note dans le menu déroulant ...

Voila

A++

Bigbang
bigbang00@caramail.com
Signaler
cs_LuTo
Messages postés
102
Date d'inscription
mercredi 9 janvier 2002
Statut
Membre
Dernière intervention
6 juin 2010
 -
Bien. Simple et efficace! Comme on aime, quoi. Ca marche impec avec Yahoo.
A quand un prog qui download les nouveaux mels et les affiche dans des textbox ?
Bonne prog.
Signaler
cs_Repie
Messages postés
103
Date d'inscription
mardi 10 octobre 2000
Statut
Membre
Dernière intervention
5 mars 2006
 -
LuTo> Je me tate ;)

j'upload une nouvelle version dès que j'ai un peu de temps (sans debug puisque à priori ca marche pour tous les serveurs et avec une progressbar)
Signaler
cs_Liberasoft
Messages postés
3
Date d'inscription
vendredi 27 octobre 2000
Statut
Membre
Dernière intervention
10 avril 2005
 -
Le prog fonctinne très bien, mais il y a juste un bug. En fait j'utilise un serveur planetinternet et quand j'utilise ton prog, pour lui tout les messages sur le serveurs sont considérés comme nouveaux. Faut peut etre rajouté un test. J'y regarde et je te dis quoi ok ?a++
Liberasoft
damiedet@pi.be
Afficher les 10 commentaires
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 (cs_Repie)