Checkeur de mail (avec winsock) maj!!!
Soyez le premier à donner votre avis sur cette source.
Vue 6 654 fois - Téléchargée 875 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é
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
- Un checkeur
- Sécurité dans 1 checkeur sur POP3 ✓ - Forum - Visual Basic
1 nov. 2009 à 08:38
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?
30 août 2005 à 16:12
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"
18 sept. 2004 à 14:20
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
12 août 2002 à 06:54
19 juil. 2002 à 18:17
Les mails restent donc sur le serveur et C l'appli qui se souvient avoir tlcharg certains (je C pas comment ca par contre).
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.