PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Droopy's Lib

https://www.purebasic.fr/french/viewtopic.php?t=2819

Page 5 sur 12

Publié : mar. 06/sept./2005 21:07
par Droopy
Nouvelle Version (1.25) 8)
  • Tweak Added : Skeleton
    Function Added : NovellClientVersion
    Function Added : ComputerSerialNumber
    Function Added : RegGetType
    Function Addon : RegGetValue can now read #REG_BINARY type
    Function Addon : RegSetValue can now write #REG_BINARY type

Publié : jeu. 08/sept./2005 18:22
par julien
Les emails envoyé avec sendemail ne fonctionne pas toujours (rarement sur hotmail.fr et yahoo.fr)
Cela doit venir des entetes

Publié : jeu. 08/sept./2005 18:28
par Droopy
Bizarre, avec Wanadoo : No Problemo

J'ai aucune idée d'où ça peut provenir, j'utilise cette fonction au Taf, sur un serveur SMTP, et n'ai aucun soucis avec .

Publié : jeu. 08/sept./2005 19:13
par julien
Quand j'essaye avec le serveur smtp de yahoo (avec autentification), il y'a 1 erreur qui me dit d'aller voir cette page :
http://cr.yp.to/docs/smtplf.html

Publié : jeu. 08/sept./2005 19:15
par julien
ne fonctionne pas non plus avec Gmail

Publié : jeu. 08/sept./2005 19:59
par Droopy
Peut tu tester l'envoie d'un mail sans corp

Publié : jeu. 08/sept./2005 20:24
par julien
Alors sous yahoo le serveur marche sans corps, je devais avoir une erreur dans le corps (fin de ligne) je vais voir

J'ai repris les sources pour mettre un debug, et j'ai tester avec Gmail, mais Gmail attent quelques chose, voicice que le serveur renvoie

Code : Tout sélectionner

mx.gmail.com ESMTP 79sm2929745rnc
mx.gmail.com at your service
250-SIZE 20971520
250-8BITMIME
250-STARTTLS
250 ENHANCEDSTATUSCODES
5.7.0 Must issue a STARTTLS command first 79sm2929745rnc
Par contre serai t'il possible de faire quelques amélioration :

- que le code retourne 1 si l'envoie est ok ou 0 si erreur
- la possibilité de changer le nom de X mailer
- peut être supprimer ceci :
Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) )

Car je me retourve avec un email au format 09/08/05 au lieu de 08/09/05 (pour septembre), et ceci est donc mal classer dans Thunderbird (mauvaise date) Le fait de supprimer cette ligne la date est remise à la bonne date (je sais pas si c bien clair?)

Voila, voila, encore merci pour cet mega lib :D

Publié : jeu. 08/sept./2005 21:08
par Droopy
J'ai ouvert un compte Yahoo et effectivement ça marche pas fort :(

j'ai aussi testé en mode debug et ça bloque chez yahoo après l'envoie du compte / pwd ( encodé en base 64 )

Ce code est de Clipper, et l'ai simplement intégré dans la Lib, Je ne sais pas où commencer pour débugguer ça, si quelqu'un à une idée ...

Code : Tout sélectionner

;- _____________________________________________________________________________
;- |                                                                           |
;- |                              SendEmail (New)                              |
;- |                              _______________                              |
;- |                                                                           |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)                                       
; Author : clipper
; PureBasic 3.93
; Sending Mail with SMTP-AUTH + add multiple attachments
; Don´t fill the Username if you don't want authentification

Enumeration 
  #eHlo 
  #RequestAuthentication 
  #Username 
  #Password 
  #MailFrom 
  #RcptTo 
  #Data 
  #Quit 
  #Complete 
EndEnumeration

ProcedureDLL SendEMailInit()
  NewList Attachments.s() 
  Global SendEMailConnectionID.l 
EndProcedure

ProcedureDLL AddAttachment(File.s)
  AddElement(Attachments()) 
  Attachments() =  File
EndProcedure
  
ProcedureDLL NoAttachment()
  ClearList(Attachments())
EndProcedure

Procedure.s GetMIMEType(Extension.s) 
  Extension = "." + Extension 
  hKey.l = 0 
  KeyValue.s = Space(255) 
  DataSize.l = 255 
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, Extension, 0, #KEY_READ, @hKey) 
    KeyValue = "application/octet-stream" 
  Else 
    If RegQueryValueEx_(hKey, "Content Type", 0, 0, @KeyValue, @DataSize) 
      KeyValue = "application/octet-stream" 
    Else 
      KeyValue = Left(KeyValue, DataSize-1) 
    EndIf 
    RegCloseKey_(hKey) 
  EndIf 
  ProcedureReturn KeyValue 
EndProcedure 

Procedure.s Base64Encode(strText.s) 
  DefType.s Result 
  *B64EncodeBufferA = AllocateMemory(Len(strText)+1) 
  *B64EncodeBufferB = AllocateMemory((Len(strText)*3)+1) 
  PokeS(*B64EncodeBufferA, strText) 
  Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText)*3) 
  Result = PeekS(*B64EncodeBufferB) 
  FreeMemory(-1) 
  ProcedureReturn Result 
EndProcedure

Procedure Send(msg.s) 
  Debug msg
  msg+#CRLF$ 
  SendNetworkData(SendEMailConnectionID, @msg, Len(msg)) 
EndProcedure 

Procedure SendFiles() 
  ResetList(Attachments()) 
  While(NextElement(Attachments())) 
    File.s=Attachments() 
    Send("") 
    If ReadFile(0,File.s) 
      InputBufferLength.l = Lof() 
      OutputBufferLength.l = InputBufferLength * 1.4 
      *memin=AllocateMemory(InputBufferLength) 
      If *memin 
        *memout=AllocateMemory(OutputBufferLength) 
        If *memout 
          Boundry.s = "--MyBoundary" 
          Send(Boundry) 
          Send("Content-Type: "+GetMIMEType(GetExtensionPart(File.s)) + "; name=" + Chr(34) + GetFilePart(File.s) + Chr(34)) 
          Send("Content-Transfer-Encoding: base64") 
          Send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(File) + Chr(34)) 
          Send("") 
          ReadData(*memin,InputBufferLength) 
          Base64Encoder(*memin,60,*memout,OutputBufferLength) 
          Send(PeekS(*memout,60)) ; this must be done because For i=0 To OutputBufferLength/60 doesn´t work 
          Base64Encoder(*memin,InputBufferLength,*memout,OutputBufferLength)                
          For i=1 To OutputBufferLength/60 
            temp.s=Trim(PeekS(*memout+i*60,60)) 
            If Len(temp)>0 
              Send(temp) 
            EndIf 
          Next 
        EndIf 
      EndIf 
      FreeMemory(-1) 
      CloseFile(0) 
    EndIf 
  Wend 
  ProcedureReturn 
EndProcedure 

ProcedureDLL SendEmail(Name.s,sender.s,recipient.s,Username.s,Password.s,smtpserver.s,subject.s,body.s) 
  If InitNetwork() 
    SendEMailConnectionID = OpenNetworkConnection(smtpserver, 25) 
    If SendEMailConnectionID 
      loop250.l=0 
      Repeat    
        If NetworkClientEvent(SendEMailConnectionID) 
          ReceivedData.s=Space(9999) 
          ct=ReceiveNetworkData(SendEMailConnectionID ,@ReceivedData,9999) 
          If ct 
            cmdID.s=Left(ReceivedData,3) 
            cmdText.s=Mid(ReceivedData,5,ct-6) 
            Select cmdID 
              Case "220" 
                If Len(Username)>0 
                  Send("Ehlo " + Hostname()) 
                  State=#eHlo 
                Else 
                  Send("HELO " + Hostname()) 
                  State=#MailFrom 
                EndIf    
              Case "221" 
                Send("[connection closed]") 
                State=#Complete 
                quit=1      
              Case "235" 
                Send("MAIL FROM: <" + sender + ">") 
                State=#RcptTo 
                
              Case "334" 
                If State=#RequestAuthentication 
                  Send(Base64Encode(Username)) 
                  State=#Username 
                EndIf 
                If State=#Username 
                  Send(Base64Encode(Password)) 
                  State=#Password 
                EndIf 
                
              Case "250" 
                Select State 
                  Case #eHlo 
                    Send("AUTH LOGIN") 
                    State=#RequestAuthentication      
                  Case #MailFrom    
                    Send("MAIL FROM: <" + sender + ">") 
                    State=#RcptTo 
                  Case #RcptTo 
                    Send("RCPT TO: <" + recipient + ">") 
                    State=#Data 
                  Case #Data 
                    Send("DATA") 
                    State=#Quit 
                  Case #Quit 
                    Send("QUIT") 
                EndSelect 
                
              Case "251" 
                Send("DATA") 
                State=#Data 
              Case "354" 
                Send("X-Mailer: eSMTP 1.0") 
                Send("To: " + recipient) 
                Send("From: " + Name + " <" + sender + ">") 
                Send("Reply-To: "+sender) 
                Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) ) 
                Send("Subject: " + subject) 
                Send("MIME-Version: 1.0") 
                Send("Content-Type: multipart/mixed; boundary="+Chr(34)+"MyBoundary"+Chr(34)) 
                Send("") 
                Send("--MyBoundary") 
                Send("Content-Type: text/plain; charset=us-ascii") 
                Send("Content-Transfer-Encoding: 7bit") 
                Send("")                      
                Send(body.s) 
                SendFiles() 
                Send("--MyBoundary--") 
                Send(".") 
                
              Case "550" 
                
                quit=1      
            EndSelect 
          EndIf 
        EndIf 
        
      Until quit = 1 
      CloseNetworkConnection(SendEMailConnectionID) 
      
    EndIf 
  EndIf          
EndProcedure

Publié : jeu. 08/sept./2005 21:29
par julien
Par contre sur @Hotmail.fr soit l'email n'arrive pas soit il est mis dans le dossier SPAM

J'ai modifié un peu les entete et ça fonctionne sur hotmail et yahoo
Le code renvoie 1 si l'envoie est ok sinon 0
Les procedure sont modifié en _2 pour pouvoir compiler sans enlever la lib
A tester
Par contre Gmail... pas du tout

Il faudrai ajouter un Timer car si le serveur n'est pas dispo ça boucle

Code : Tout sélectionner


;- _____________________________________________________________________________
;- |                                                                           |
;- |                              SendEmail (New)                              |
;- |                              _______________                              |
;- |                                                                           |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)                                       
; Author : clipper
; PureBasic 3.93
; Sending Mail with SMTP-AUTH + add multiple attachments
; Don´t fill the Username if you don't want authentification

Enumeration 
  #eHlo 
  #RequestAuthentication 
  #Username 
  #Password 
  #MailFrom 
  #RcptTo 
  #Data 
  #Quit 
  #Complete 
EndEnumeration

Procedure SendEMailInit_2()
  NewList Attachments.s() 
  Global SendEMailConnectionID.l 
EndProcedure

Procedure AddAttachment_2(File.s)
  AddElement(Attachments()) 
  Attachments() =  file
EndProcedure
  
Procedure NoAttachment_2()
  ClearList(Attachments())
EndProcedure

Procedure.s GetMIMEType_2(Extension.s) 
  Extension = "." + Extension 
  hKey.l = 0 
  KeyValue.s = Space(255) 
  DataSize.l = 255 
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, Extension, 0, #KEY_READ, @hKey) 
    KeyValue = "application/octet-stream" 
  Else 
    If RegQueryValueEx_(hKey, "Content Type", 0, 0, @KeyValue, @DataSize) 
      KeyValue = "application/octet-stream" 
    Else 
      KeyValue = Left(KeyValue, DataSize-1) 
    EndIf 
    RegCloseKey_(hKey) 
  EndIf 
  ProcedureReturn KeyValue 
EndProcedure 

Procedure.s Base64Encode_2(strText.s) 
  DefType.s Result 
  *B64EncodeBufferA = AllocateMemory(Len(strText)+1) 
  *B64EncodeBufferB = AllocateMemory((Len(strText)*3)+1) 
  PokeS(*B64EncodeBufferA, strText) 
  Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText)*3) 
  Result = PeekS(*B64EncodeBufferB) 
  FreeMemory(-1) 
  ProcedureReturn Result 
EndProcedure

Procedure Send_2(msg.s) 
  msg+#CRLF$ 
  
  SendNetworkData(SendEMailConnectionID, @msg, Len(msg)) 
EndProcedure 

Procedure SendFiles_2() 
  ResetList(Attachments()) 
  While(NextElement(Attachments())) 
    file.s=Attachments() 
    Send_2("") 
    If ReadFile(0,file.s) 
      InputBufferLength.l = Lof() 
      OutputBufferLength.l = InputBufferLength * 1.4 
      *memin=AllocateMemory(InputBufferLength) 
      If *memin 
        *memout=AllocateMemory(OutputBufferLength) 
        If *memout 
          Boundry.s = "--MyBoundary" 
          Send_2(Boundry) 
          Send_2("Content-Type: "+GetMIMEType_2(GetExtensionPart(file.s)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34)) 
          Send_2("Content-Transfer-Encoding: base64") 
          Send_2("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34)) 
          Send_2("") 
          ReadData(*memin,InputBufferLength) 
          Base64Encoder(*memin,60,*memout,OutputBufferLength) 
          Send_2(PeekS(*memout,60)) ; this must be done because For i=0 To OutputBufferLength/60 doesn´t work 
          Base64Encoder(*memin,InputBufferLength,*memout,OutputBufferLength)                
          For i=1 To OutputBufferLength/60 
            temp.s=Trim(PeekS(*memout+i*60,60)) 
            If Len(temp)>0 
              Send_2(temp) 
            EndIf 
          Next 
        EndIf 
      EndIf 
      FreeMemory(-1) 
      CloseFile(0) 
    EndIf 
  Wend 
  ProcedureReturn 
EndProcedure 

ProcedureDLL SendEmail_2(Name.s,sender.s,recipient.s,Username.s,Password.s,smtpserver.s,subject.s,body.s) 
   envoie_ok=0
    SendEMailConnectionID = OpenNetworkConnection(smtpserver, 25) 
    If SendEMailConnectionID 
      loop250.l=0 
      Repeat    
        If NetworkClientEvent(SendEMailConnectionID) 
          ReceivedData.s=Space(9999) 
          ct=ReceiveNetworkData(SendEMailConnectionID ,@ReceivedData,9999) 
          If ct 
            cmdID.s=Left(ReceivedData,3) 
            cmdText.s=Mid(ReceivedData,5,ct-6) 
            Debug cmdText.s
            Select cmdID 
              Case "220" 
                If Len(Username)>0 
                  Send_2("Ehlo " + Hostname()) 
                  State=#eHlo 
                Else 
                  Send_2("HELO " + Hostname()) 
                  State=#MailFrom 
                EndIf    
              Case "221" 
                Send_2("[connection closed]") 
                State=#Complete 
                quit=1      
              Case "235" 
                Send_2("MAIL FROM: <" + sender + ">") 
                State=#RcptTo 
                
              Case "334" 
                If State=#RequestAuthentication 
                  Send_2(Base64Encode_2(Username)) 
                  State=#Username 
                EndIf 
                If State=#Username 
                  Send_2(Base64Encode_2(password)) 
                  state=#Password 
                EndIf 
                
              Case "250" 
                Select state 
                  Case #eHlo 
                    Send_2("AUTH LOGIN") 
                    state=#RequestAuthentication      
                  Case #MailFrom    
                    Send_2("MAIL FROM: <" + sender + ">") 
                    state=#RcptTo 
                  Case #RcptTo 
                    Send_2("RCPT TO: <" + recipient + ">") 
                    state=#Data 
                  Case #Data 
                    Send_2("DATA") 
                    state=#Quit 
                  Case #Quit 
                    Send_2("QUIT") 
                EndSelect 
                
              Case "251" 
                Send_2("DATA") 
                state=#Data 
              Case "354" 
                Send_2("X-Mailer: HelloMailL") 
                Send_2("To: " + recipient) 
                Send_2("From: " + name + " <" + sender + ">") 
                Send_2("Reply-To: "+sender) 
                ;Send_2("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) ) 
                Send_2("Subject: " + subject) 
                Send_2("MIME-Version: 1.0") 
                Send_2("Content-Type: multipart/mixed; boundary="+Chr(34)+"MyBoundary"+Chr(34)) 
                Send_2("") 
                Send_2("--MyBoundary") 
                Send_2("Content-Type: text/plain; charset=us-ascii") 
                Send_2("Content-Transfer-Encoding: 7bit") 
                Send_2("")                      
                Send_2(body.s) 
                SendFiles_2() 
                Send_2("--MyBoundary--") 
                Send_2(".") 
                envoie_ok=1
              Case "550" 
                
                quit=1      
            EndSelect 
          EndIf 
        EndIf 
        
      Until quit = 1 
      CloseNetworkConnection(SendEMailConnectionID) 
      
    EndIf 
        ProcedureReturn envoie_ok
EndProcedure

Publié : jeu. 08/sept./2005 21:40
par Droopy
J'ai testé ton code sur yahoo.fr et il me jette après l'autentification
authorization failed (#5.7.0)
:?:

Publié : ven. 09/sept./2005 5:05
par julien
Fonctionne avec Yahoo chez moi
As tu mis les bon parametre ?
SMTP: smtp.mail.yahoo.fr
User : blabla (il ne faut pas mettre @yahoo.fr)
MDP : ***




Par contre l'envoie sur les webmail (voila.fr) les ' ou é... sont remplacé par des ? quand j'envoie du TEXTE

A voir dans les entêtes

Publié : ven. 09/sept./2005 8:18
par Droopy
julien a écrit :Fonctionne avec Yahoo chez moi
SMTP: smtp.mail.yahoo.fr
User : blabla (il ne faut pas mettre @yahoo.fr)
MDP : ***
Oui j'ai fait ça et ça me jette :?:

Publié : ven. 09/sept./2005 10:53
par julien
tu as activé l'utilisation des serveurs Pop et SMTP dans l'interface web de yahoo ? (obligation de recevoir quelques pub sur *@yahoo.fr)

Publié : ven. 09/sept./2005 11:19
par gnozal
Je ne sais pas si le problème vient de là, mais j'ai une remarque sur l'encodage base64 :

Base64Encoder(InputBuffer, InputLength, OutputBuffer, OutputLength)

The output buffer should be at last 33% bigger than the input buffer, with a minimum size of 64 bytes.

Ton code ne vérifie pas cela il me semble.

Dans ma lib PureSMTP, je vérifie cela.

Code : Tout sélectionner

  InputBufferLength = Len(strText)
  OutputBufferLength = InputBufferLength * 2 ; et pas * 1.33 comme dans le manuel !
  If OutputBufferLength < 64
    OutputBufferLength = 64
  EndIf

Publié : ven. 09/sept./2005 13:36
par Droopy
Merci je regarde ça ce soir
Fuseau horaire sur UTC+01:00
Page 5 sur 12

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru