Checkeur de mail (avec winsock) maj!!!

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

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)