Droopy's Lib

Vous avez développé un logiciel en PureBasic et vous souhaitez le faire connaitre ?
Répondre
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message 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
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message par julien »

Les emails envoyé avec sendemail ne fonctionne pas toujours (rarement sur hotmail.fr et yahoo.fr)
Cela doit venir des entetes
Haut
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message 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 .
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message 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
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message par julien »

ne fonctionne pas non plus avec Gmail
Haut
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message par Droopy »

Peut tu tester l'envoie d'un mail sans corp
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message 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
Haut
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message 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
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message 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
Haut
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message par Droopy »

J'ai testé ton code sur yahoo.fr et il me jette après l'autentification
authorization failed (#5.7.0)
:?:
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message 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
Haut
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message 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 :?:
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message 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)
Haut
gnozal
Messages : 832
Inscription : mar. 07/déc./2004 17:35
Localisation : France
Contact :
Contacter gnozal

Message 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
Haut
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message par Droopy »

Merci je regarde ça ce soir
Haut
Répondre

Revenir à « Annonces »