Surveillance des mails
Publié : dim. 10/avr./2011 18:02
Pourriez-vous tester ce code?
J'ai commencé ça pour faire une appli qui tournera en tache de fond sur mon PC, et m'avertira quand un nouveau message arrivera sur une de mes boites mail.
Pour le moment, il n'y a pas de fenêtre, il y a juste le code qui permet de se connecter au serveur et de relever les en-têtes de message. (A lancer en mode Debug, donc)
A priori, ça fonctionne sur toutes mes boites, mais par moment, quand on le lance souvent sur la même, il a tendance à oublier des messages.
Le truc, c'est que je ne connais pas assez le fonctionnement des commandes pop3 pour comprendre exactement pourquoi il oublie des messages.
J'ai bien placé des "Delay(xx)" ici et là, ça améliore un peu les choses, mais c'est pas encore ça. Et vu que ça fait déjà plusieurs jours que je fouille le net pour trouver des renseignements, ça commence à me prendre un peu le cerveau.
Donc, si vous voulez tester ça chez vous et me dire si ça fonctionne bien ou ce que je peux faire pour améliorer ce truc...
PS: Je ne veux pas de commandes à base d'API ou de lib.
Il faut que ça tourne uniquement avec les commandes dispo dans Pure 4.51.
J'ai commencé ça pour faire une appli qui tournera en tache de fond sur mon PC, et m'avertira quand un nouveau message arrivera sur une de mes boites mail.
Pour le moment, il n'y a pas de fenêtre, il y a juste le code qui permet de se connecter au serveur et de relever les en-têtes de message. (A lancer en mode Debug, donc)
A priori, ça fonctionne sur toutes mes boites, mais par moment, quand on le lance souvent sur la même, il a tendance à oublier des messages.
Le truc, c'est que je ne connais pas assez le fonctionnement des commandes pop3 pour comprendre exactement pourquoi il oublie des messages.
J'ai bien placé des "Delay(xx)" ici et là, ça améliore un peu les choses, mais c'est pas encore ça. Et vu que ça fait déjà plusieurs jours que je fouille le net pour trouver des renseignements, ça commence à me prendre un peu le cerveau.
Donc, si vous voulez tester ça chez vous et me dire si ça fonctionne bien ou ce que je peux faire pour améliorer ce truc...
PS: Je ne veux pas de commandes à base d'API ou de lib.
Il faut que ça tourne uniquement avec les commandes dispo dans Pure 4.51.

Code : Tout sélectionner
;{/ Initialisation du réseau
If InitNetwork() = 0
MessageRequester("ERREUR", "Impossible d'initialiser le réseau", 0) : End
EndIf
;}
;{/ Structures
Structure MESSAGES
IDMessage.s ; Id du message
Name.s ; Nom de l'expéditeur
Expe.s ; Mail de l'expéditeur
Dest.s ; Mail du destinataire
Subj.s ; Sujet du message
EndStructure
;}
;{/ Tableaux et Listes
Global NewList Mails.MESSAGES()
Global Dim Caracteres.s(2, 190)
Global CRLF$ = Chr(13)+Chr(10) ;}
;{/ Chargement du tableau de caractères
Restore Utf8
For y = 0 To 190
Read.s i$ : Caracteres(0,y) = i$
Next
Restore Machin
For y = 0 To 190
Read.s i$ : Caracteres(1,y) = i$
Next
Restore Ascii
For y = 0 To 190
Read.s i$ : Caracteres(2,y) = i$
Next;}
;{/ Oooops, plantage!!!
Macro ErrorMsg
MessageRequester("Oooopss", "Une erreur est survenue pendant la connexion."+Chr(10)+"Impossible d'accéder aux serveur.")
EndMacro
;}
;{/ Procédures
;/ Décodage mode "Base64"
Procedure.s DecodeB64(Texte.s, Charset.s)
Charset = LCase(Charset)
Tampon.s = Space(1024)
ChaineDec.s = Space(1024)
PokeS(@Tampon, Texte+CRLF$)
Select Charset
Case "utf-8"
Base64Decoder(@Tampon, StringByteLength(Tampon, #PB_UTF8), @ChaineDec, 1024)
E$ = PeekS(@ChaineDec, 1024, #PB_UTF8)
Default
Base64Decoder(@Tampon, StringByteLength(Tampon, #PB_Ascii), @ChaineDec, 1024)
E$ = PeekS(@ChaineDec, 1024, #PB_Ascii)
EndSelect
Tampon = Space(0)
ChaineDec = Space(0)
ProcedureReturn E$
EndProcedure
;/ Décodage mode "Quoted-Printable"
Procedure.s DecodeQuotedPrintable(Text.s, Charset.s)
Charset = LCase(Charset)
Select Charset
Case "utf-8"
For i = 0 To 190
Text = ReplaceString(Text, Caracteres(0,i), Caracteres(2,i))
Text = ReplaceString(Text, "_", " ")
Next
Default
For i = 0 To 190
Text = ReplaceString(Text, Caracteres(1,i), Caracteres(2,i))
Text = ReplaceString(Text, "_", " ")
Next
EndSelect
ProcedureReturn Text
EndProcedure
;/ Récupération des adresses mail
Procedure.s GetMail(Texte.s)
If CreateRegularExpression(0, "[a-zA-Z0-9\-\.]+@[a-zA-Z0-9\-]+\.[a-zA-Z]+")
Dim Result$(0)
a = ExtractRegularExpression(0, Texte, Result$())
For k=0 To a-1
Mail.s + Result$(k)
Next
FreeRegularExpression(0)
EndIf
ProcedureReturn Mail
EndProcedure
;/ Extraction des données de l'en-tête
Procedure.s GetDatas(Message.s)
Message = ReplaceString(Message, CRLF$, ";")
Message = RemoveString(Message, Chr(9)) : Message = RemoveString(Message, Chr(34))
;- Recherche du nombre de lignes
NumLines.b = CountString(Message, ";") : a$ = ""
For i = 1 To NumLines -1
Line$ = StringField(Message, i, ";")
Line$ = Trim(Line$)
;{/ Extraction des données "From: "
If Left(Line$, 6) = "From: "
From$ = Right(Line$, Len(Line$)-Len("From: "))
If Left(From$, 2) = "=?"
Charset$ = StringField(From$, 2, "?")
Codage$ = StringField(From$, 3, "?")
Texte$ = StringField(From$, 4, "?")
If Codage$ = "B" Or Codage$ = "b"
Expediteur$ = DecodeB64(Texte$, Charset$)
EndIf
Else
Expediteur$ = StringField(From$, 1, "<")
EndIf
ExpMail$ = StringField(From$, 2, "<")
ExpMail$ = RemoveString(ExpMail$, ">")
EndIf;}
;{/ Extraction des données "To: "
If Left(Line$, 4) = "To: "
LineTo$ = Right(Line$, Len(Line$)-Len("To: "))
DestMail$ = GetMail(LineTo$)
EndIf;}
;{/ Extraction des données "Subject: "
If Left(Line$, 9) = "Subject: "
LineSubj$ = Right(Line$, Len(Line$)-Len("Subject: "))
If Left(LineSubj$, 2) = "=?" : I2 = i
Charset$ = StringField(LineSubj$, 2, "?")
Codage$ = StringField(LineSubj$, 3, "?")
Texte$ = StringField(LineSubj$, 4, "?")
If Right(Texte$, 1) = "="
Texte$ = Left(Texte$, Len(Texte$)-1)
EndIf
If Codage$ = "B" Or Codage$ = "b"
MainSubj$ = DecodeB64(Texte$, Charset$)
ElseIf Codage$ = "Q" Or Codage$ = "q"
MainSubj$ = DecodeQuotedPrintable(Texte$, Charset$)
EndIf
Repeat
I2 + 1
Tmp$ = Trim(StringField(Message, I2, ";"))
If Left(Tmp$, 2) = "=?"
Charset$ = StringField(Tmp$, 2, "?")
Codage$ = StringField(Tmp$, 3, "?")
Texte$ = StringField(Tmp$, 4, "?")
If Codage$ = "B" Or Codage$ = "b"
SecSubj$ = DecodeB64(Texte$, Charset$)
ElseIf Codage$ = "Q" Or Codage$ = "q"
SecSubj$ = DecodeQuotedPrintable(Texte$, Charset$)
EndIf
MainSubj$ + SecSubj$
EndIf
Until Left(Tmp$, 2) <> "=?"
MainSubj$ = DecodeQuotedPrintable(MainSubj$, "utf-8")
MainSubj$ = DecodeQuotedPrintable(MainSubj$, "")
MainSubj$ = ReplaceString(MainSubj$, Chr(127), " ")
Else
MainSubj$ = LineSubj$
EndIf
EndIf;}
;{/ Extraction de l'ID du message
If LCase(Left(Line$, 12)) = "message-id: "
LineId$ = Right(Line$, Len(Line$)-Len("message-id: "))
EndIf;}
Next
;{/ Remplissage de la liste
AddElement(Mails())
Mails()\IDMessage = LineId$
Mails()\Name = Expediteur$
Mails()\Expe = ExpMail$
Mails()\Dest = DestMail$
Mails()\Subj = MainSubj$ ;}
ProcedureReturn
EndProcedure
;/ Connexion au Serveur de Mail
Procedure ConnectToServer(Serveur.s, Port, UserID.s, UserPass.s)
ConnectID = OpenNetworkConnection(Serveur, Port)
If ConnectID
Rep$ = "" : *Buffer = AllocateMemory(5000)
Res = ReceiveNetworkData(ConnectID, *Buffer, 5000)
If Res <> -1
Rep$ = Trim(PeekS(*Buffer)): Result$ = Rep$
FreeMemory(*Buffer)
EndIf
;/ Envoi du Login
If FindString(Rep$, "+OK", 1)
SendNetworkString(ConnectID, "USER " + UserID + CRLF$)
Rep$ = "" : *Buffer = AllocateMemory(5000)
Res = ReceiveNetworkData(ConnectID, *Buffer, 5000)
If Res <> -1
Rep$ = PeekS(*Buffer) : Result$ = Rep$
FreeMemory(*Buffer)
EndIf
EndIf
;/ Envoi du mot de passe
If FindString( Result$, "+OK", 1)
SendNetworkString(ConnectID, "PASS " + UserPass + CRLF$)
Rep$ = "" : *Buffer = AllocateMemory(5000)
Res = ReceiveNetworkData(ConnectID, *Buffer, 5000)
If Res <> -1
Rep$ = PeekS(*Buffer) : Result$ = Rep$
FreeMemory(*Buffer)
Else
ErrorMsg
FreeMemory(*Buffer)
EndIf
EndIf
;/ Récupération du nombre de messages
If FindString(Result$, "+OK", 1)
SendNetworkString(ConnectID, "STAT" + CRLF$) : Delay(100)
Rep$ = "" : *Buffer = AllocateMemory(5000)
Res = ReceiveNetworkData(ConnectID, *Buffer, 5000)
If Res <> -1
Rep$ = PeekS(*Buffer) : Result$ = Rep$
FreeMemory(*Buffer)
If FindString(Result$, "+OK", 1)
Num$ = Trim(Right(Result$, Len(Result$)-Len("+OK ")))
NbMessages$ = StringField(Num$, 1, " ") : Debug "Vous avez " + NbMessages$ + " messages" : Debug ""
NbMessages = Val(StringField(NbMessages$,1, " "))
EndIf
Else
ErrorMsg
FreeMemory(*Buffer)
EndIf
EndIf
;/ Récupération de la taille en octet de chaque message (Juste pour info, car semble inutile pour les en-têtes)
; For i = 1 To NbMessages
; If FindString(Result$, "+OK", 1)
; SendNetworkString(ConnectID, "LIST " + Str(i) + CRLF$) : Delay(50)
; Rep$ = "" : *Buffer = AllocateMemory(1000)
; Res = ReceiveNetworkData(ConnectID, *Buffer, 1000); : Debug Res
; Rep$ = PeekS(*Buffer) : Result$ = Rep$ : Debug Result$
; FreeMemory(*Buffer)
; EndIf
; Next
;/ Récupération des en-têtes des messages
For i = 1 To NbMessages
If FindString(Result$, "+OK", 1)
SendNetworkString(ConnectID, "TOP "+Str(i) + " 0"+ CRLF$) : Delay(400)
Rep$ = "" : *Buffer = AllocateMemory(10000)
Repeat
Res = ReceiveNetworkData(ConnectID, *Buffer, 10000)
Rep$ = PeekS(*Buffer) : Result$ = Rep$
Until Res < MemorySize(*Buffer)
FreeMemory(*Buffer)
GetDatas(Result$)
Delay(150)
EndIf
Next
If FindString(Rep$, "+OK", 1)
SendNetworkString(ConnectID, "QUIT" + CRLF$)
Rep$ = "" : *Buffer = AllocateMemory(5000)
Res = ReceiveNetworkData(ConnectID, *Buffer, 5000)
If Res <> -1
Rep$ = PeekS(*Buffer) : Result$ = Rep$ : Debug Result$
FreeMemory(*Buffer)
EndIf
EndIf
Else
MessageRequester("Erreur", "La connexion a échouée")
EndIf
CloseNetworkConnection(ConnectID)
EndProcedure
;/ Lecture de la liste
Procedure Lire()
ForEach Mails()
ID$ = Mails()\IDMessage : Debug "ID : " + ID$
Nom$ = Mails()\Name : Debug "De : " + Nom$
Expediteur$ = Mails()\Expe : Debug "Addresse : " + Expediteur$
Destinataire$ = Mails()\Dest : Debug "A : " + Destinataire$
Sujet$ = Mails()\Subj : Debug "Sujet : " + Sujet$
Debug " -------------- "
Next
;}
EndProcedure
;-
;/ Adresses Mail
Serv.s = "pop.monserveur.fr"
Pt.w = 110
User.s = "truc-chose@monserveur.fr"
Pass.s = "MonMotDePass"
ConnectToServer(Serv, Pt, User, Pass)
Lire()
End
DataSection
Utf8:
Data.s "=20","=21","=22","=23","=24","=25","=26","=27","=28","=29","=2A","=2B","=2C","=2D","=2E"
Data.s "=2F","=30","=31","=32","=33","=34","=35","=36","=37","=38","=39","=3A","=3B","=3C","=3D","=3E"
Data.s "=3F","=40","=41","=42","=43","=44","=45","=46","=47","=48","=49","=4A","=4B","=4C","=4D","=4E"
Data.s "=4F","=50","=51","=52","=53","=54","=55","=56","=57","=58","=59","=5A","=5B","=5C","=5D","=5E"
Data.s "=5F","=60","=61","=62","=63","=64","=65","=66","=67","=68","=69","=6A","=6B","=6C","=6D","=6E"
Data.s "=6F","=70","=71","=72","=73","=74","=75","=76","=77","=78","=79","=7A","=7B","=7C","=7D","=7E"
Data.s "=C2=A0","=C2=A1","=C2=A2","=C2=A3","=C2=A4","=C2=A5","=C2=A6","=C2=A7","=C2=A8","=C2=A9","=C2=AA"
Data.s "=C2=AB","=C2=AC","=C2=AD","=C2=AE","=C2=AF","=C2=B0","=C2=B1","=C2=B2","=C2=B3","=C2=B4","=C2=B5"
Data.s "=C2=B6","=C2=B7","=C2=B8","=C2=B9","=C2=BA","=C2=BB","=C2=BC","=C2=BD","=C2=BE","=C2=BF","=C3=80"
Data.s "=C3=81","=C3=82","=C3=83","=C3=84","=C3=85","=C3=86","=C3=87","=C3=88","=C3=89","=C3=8A","=C3=8B"
Data.s "=C3=8C","=C3=8D","=C3=8E","=C3=8F","=C3=90","=C3=91","=C3=92","=C3=93","=C3=94","=C3=95","=C3=96"
Data.s "=C3=97","=C3=98","=C3=99","=C3=9A","=C3=9B","=C3=9C","=C3=9D","=C3=9E","=C3=9F","=C3=A0","=C3=A1"
Data.s "=C3=A2","=C3=A3","=C3=A4","=C3=A5","=C3=A6","=C3=A7","=C3=A8","=C3=A9","=C3=AA","=C3=AB","=C3=AC"
Data.s "=C3=AD","=C3=AE","=C3=AF","=C3=B0","=C3=B1","=C3=B2","=C3=B3","=C3=B4","=C3=B5","=C3=B6","=C3=B7"
Data.s "=C3=B8","=C3=B9","=C3=BA","=C3=BB","=C3=BC","=C3=BD","=C3=BE","=C3=BF"
Machin:
Data.s "=20","=21","=22","=23","=24","=25","=26","=27","=28","=29","=2A","=2B","=2C","=2D","=2E"
Data.s "=2F","=30","=31","=32","=33","=34","=35","=36","=37","=38","=39","=3A","=3B","=3C","=3D","=3E"
Data.s "=3F","=40","=41","=42","=43","=44","=45","=46","=47","=48","=69","=4A","=4B","=4C","=4D","=4E"
Data.s "=4F","=50","=51","=52","=53","=54","=55","=56","=57","=58","=79","=5A","=5B","=5C","=5D","=5E"
Data.s "=5F","=60","=41","=42","=43","=44","=45","=46","=47","=48","=69","=4A","=4B","=4C","=4D","=4E"
Data.s "=4F","=50","=51","=52","=53","=54","=55","=56","=57","=58","=79","=5A","=7B","=7C","=7D","=7E"
Data.s "=7F","=A1","=A2","=A3","=A4","=A5","=A6","=A7","=A8","=A9","=AA","=AB","=AC","=AD","=AE","=AF"
Data.s "=B0","=B1","=B2","=B3","=B4","=B5","=B6","=B7","=B8","=B9","=BA","=BB","=BC","=BD","=BE","=BF"
Data.s "=C0","=C1","=C2","=C3","=C4","=C5","=C6","=C7","=C8","=C9","=CA","=CB","=CC","=CD","=CE","=CF"
Data.s "=D0","=D1","=D2","=D3","=D4","=D5","=D6","=D7","=D8","=D9","=DA","=DB","=DC","=DD","=DE","=DF"
Data.s "=E0","=E1","=E2","=E3","=E4","=E5","=E6","=E7","=E8","=E9","=EA","=EB","=EC","=ED","=EE","=EF"
Data.s "=F0","=F1","=F2","=F3","=F4","=F5","=F6","=F7","=F8","=F9","=FA","=FB","=FC","=FD","=FE","=FF"
Ascii:
Data.s " ","!",Chr(34),"#","$","%","&","'","(",")","*","+",",","-",".","/","0","1","2","3","4"
Data.s "5","6","7","8","9",":",Chr(59),"<","=",">","?","@","A","B","C","D","E","F","G","H","i","J","K"
Data.s "L","M","N","O","P","Q","R","S","T","U","V","W","X","y","Z","[","\","]","^","_","`","A","B","C"
Data.s "D","E","F","G","H","i","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","y","Z","{"
Data.s "|","}","~",Chr(127),"¡","¢","£","¤","¥","¦","§","¨","©","ª","«","¬","","®","¯","°","±","²","³"
Data.s "´","µ","¶","·","¸","¹","º","»","¼","½","¾","¿","À","Á","Â","Ã","Ä","Å","Æ","Ç","È","É","Ê","Ë"
Data.s "Ì","Í","Î","Ï","Ð","Ñ","Ò","Ó","Ô","Õ","Ö","×","Ø","Ù","Ú","Û","Ü","Ý","Þ","ß","à","á","â","ã"
Data.s "ä","å","æ","ç","è","é","ê","ë","ì","í","î","ï","ð","ñ","ò","ó","ô","õ","ö","÷","ø","ù","ú","û"
Data.s "ü","ý","þ","ÿ"
EndDataSection