Surveillance des mails

[Chris]

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.

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

[venom]

Fonctionne pas chez moi avec hotmail.

après une longue attente sa me renvoie :

La connexion a échouée
avec pour pop3 = pop3.live.com









@++

[Chris]

Pour Hotmail, il me semble qu'il faut une connexion sécurisée.
Le code n'a pas été fait pour ça au départ.
On peut certainement le faire, mais je ne sais pas comment.

[Edit]
Après quelques recherches, il faut effectivement activer le mode SSL pour la connexion pop3 sur Homail, de même que sur GMail ou d'autres.
Ça ne sera donc jamais fait, tout au moins par moi.

J'ai un compte Hotmail dont je ne me sers jamais, et un compte GMail dont je ne me rappelle même plus les identifiants.

Tout ça pour te dire à quel point la programmation de ce genre de truc m'intéresse.

[Le Soldat Inconnu]

fonctionne sur ma boite bbox
hormis qu'il retourne le nombre de message dans la boite, et pas le nombre de message non lu
ensuite, c'est assez lent pour la lecture des messages (1 minute je pense), mais ça fonctionne.

[Chris]

Normal qu'il ne retourne que le total des messages, il n'est pas prévu pour les lire, mais uniquement pour surveiller périodiquement si de nouveaux messages sont arrivés.

Ce serait quand même con qu'il vérifie s'il y a des messages, qu'il te dise "Tu as un nouveau message de machin...", et .... qu'il l'efface

L'effacement se fait quand tu télécharges le message dans ton logiciel de mail (si l'option d'effacement est activée)

[Le Soldat Inconnu]

j'ai modifié la lecture de l'entête des messages, ça me semble plus logique de cette manière

Code : Tout sélectionner

For i = 1 To NbMessages
			; If FindString(Result$, "+OK", 1)
			
			  SendNetworkString(ConnectID, "TOP "+Str(i) + " 0"+ CRLF$)
				*Buffer = AllocateMemory(15000) 
				Result$ = ""
				
				Repeat
					Res = ReceiveNetworkData(ConnectID, *Buffer, 15000)
					Rep$ = PeekS(*Buffer) : Result$ + Rep$
					
				Until Res < MemorySize(*Buffer) Or Res = -1
				FreeMemory(*Buffer)
				
				GetDatas(Result$)
				Delay(150)
				
			; EndIf
		Next

Tu en penses quoi ?

Je n'ai pas compris le "If FindString(Result$, "+OK", 1)" d'autant que tu testes Result$ alors qu'il est renseigné dans le If
ensuite, ta boucle était mal codé, il faut l'arrêter en cas d'erreur, et il faut que tu colles bout à bout chaque morceaux lu avec le ReceiveNetworkData
Result$ + Rep$ au lieu de Result$ = Rep$ plus le reset de Result$ avant la boucle repeat

je lis mes 87 mails sans soucis

[Le Soldat Inconnu]

mais uniquement pour surveiller périodiquement si de nouveaux messages sont arrivés.

moi, il me donne 87 messages alors que mes 87 messages sont lus.

[Chris]

Beaucoup plus rapide, en effet.
J'adopte!

Pour tes 87 messages, si ils ont lus, ils ne sont pas forcément effaces du serveur.
Il faut voir ça avec ton logiciel de mail habituel.

Sur Window Live Mail, par exemple, il y a une case à cocher dans les paramètres avancés : "Conserver une copie sur le serveur" et des options concernant la suppression des messages

[Le Soldat Inconnu]

en fait, je lis mes emails en imap (synchronisation entre client mails et serveur) et pas en pop3. donc mon compte mail est forcément plein de mail

[Chris]

Et lequel est le meilleur? Imap, ou Pop3?

[Ar-S]

- Pop rappatrie tes message et les supprime
- imap synchronise les messages webmail et soft en local, donc même si ton ordi crash, tu as toujours moyen de récupe les mails online...
par contre si ton compte web mail se fait hacker ou si google/yahoo/hotmail et autre gros te le ire sans raison, tu l'as dans l'os.
Donc les 2 sont intéressants.
Tu dois bien pouvoir faire les 2 (rapatrier et laisser sur le serveur) mais perso j'utilise que du webmail (et parfois imap via thunderbird).

[case]

en pop t'es pas forcé de les supprimer les messages

tout sur le protocoel pop3

http://www.iprelax.fr/pop/

[Chris]

en pop t'es pas forcé de les supprimer les messages

tout sur le protocoel pop3

http://www.iprelax.fr/pop/

Bah non, c'est ce que je dis depuis trois messages.
Si tu n'envoie pas la commande "DELE Msg" au serveur, il garde tes messages au frigo pour plus tard.

Moi aussi, j'ai mes sources:
RFC en Français

[case]

merci pour le lien , on a toujours besoin de docs un jour