PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

SMTP AUTH example

https://www.purebasic.fr/english/viewtopic.php?t=12985

Page 2 of 2

Posted: Fri Aug 19, 2005 11:56 am
by zikitrake
Clipper (or somebody)... how can I send with your example an email to more than one people????


I try

Code: Select all

Destination$ = "user1@email.com; user2@email.com"
sendesmtpmail("Clipper","my@email.com",Destination$,"username","password","auth.smtp.mailserver.com","Hallo","This is the body")
Thank you, community!

Posted: Fri Aug 19, 2005 2:13 pm
by fweil
@zikitrake,

In my own software, I use to set a MailTo.s variable with multiple recipients ; separated and when sending the RCPT TO: command to smtp I split the list by using StringField() PB command.

MailTo.s = "rctp1@server1.com; rcpt2@server2.com" ; (in the caller)

and

i = 1
While StringField(MailTo, i, ";") <> ""
Send(ConnectionID, "RCPT TO: <" + StringField(MailTo, i, ";") + ">" + Chr(13) + Chr(10))
Receive(ConnectionID)
i + 1
Wend

in the protocol management part.

It is easy to update in any code.

The basics here is that you can give as much recipients as you need by sending one by one with a RCPT TO: command from SMTP protocol.

Posted: Fri Aug 19, 2005 3:14 pm
by zikitrake
fweil thank you; I'll try your code tomorrow

Re: SMTP AUTH example

Posted: Thu Feb 25, 2010 9:20 pm
by Straker
Wow - talk about old threads! Blow the dust off this one.

Anyway, I've been using the above clipper code but the "Date:" field data sometimes throws off some mail recipients because their mail servers/clients don't know how to interpret it (and I have had some complaining customers - gotta keep em happy). Basically its not RFC 2822 compliant. So I wrote this code to return the current (and compliant format) UTC (GMT) date time so I don't have to worry about timezone differences, etc. It calls an external website to get and parse the UTC, so use at your own risk. :wink:

Specifically change:

Code: Select all

send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) )
to:

Code: Select all

send("Date: " + GetUTC() )
using the code below.

If your outgoing mail server is in GMT, then change the "-0000" to "+0000" to really be RFC compliant.

Code: Select all

Procedure.s OpenURL(pUrl.s,pOpenType.b)
  ; OpenURL procedure by ricardo 2003
  
  Protected isLoop.b, INET_RELOAD.l, hInet.l, hURL.l, Bytes.l
  Protected buffer.s, res.s
  
  isLoop.b=1
  INET_RELOAD.l=$80000000
  hInet.l=0: hURL.l=0: Bytes.l=0
  buffer.s=Space(2048)
  hInet = InternetOpen_("PB@INET", pOpenType, #Null, #Null, 0)
  hURL = InternetOpenUrl_(hInet, pUrl, #Null, 0, INET_RELOAD, 0)
  Repeat
    Delay(1)
    InternetReadFile_(hURL, @buffer, Len(buffer), @Bytes)
    If Bytes = 0
      isLoop=0
    Else
      res.s = res + Left(buffer, Bytes)
    EndIf
  Until isLoop=0

  InternetCloseHandle_(hURL)
  InternetCloseHandle_(hInet)

  ProcedureReturn res
EndProcedure

Procedure.s ParseTagValue(pString.s,pStartTag.s,pEndTag.s)
  Protected lRetVal.s, lPos1.l, lPos2.l
  
  lRetVal.s = ""
  
  lPos1.l = FindString(pString.s,pStartTag.s,1)
  
  If (lPos1.l > 0)
    lPos2.l = FindString(pString.s,pEndTag.s,lPos1.l)
    If (lPos2.l > 0)
      lPos1.l = (lPos1.l +  Len(pStartTag.s))
      lRetVal.s = Mid(pString.s,lPos1.l,(lPos2.l - lPos1.l))
    EndIf
  EndIf
  
  ProcedureReturn lRetVal.s
EndProcedure

Procedure.s GetUTC()
  Protected lRetVal.s, lUrl.s, lUrlResult.s, lPos1.l, lPos2.l
  Protected lFirstString.s, lSecondString.s, lThirdString.s, lFourthString.s
  Protected lMonth.s, lDay.s, lTime.s, lMonthInt.l, lParseResult.s, lDow.s, lYear.s
  
  lRetVal.s = ""
  lUrl.s = "http://www.time.gov/timezone.cgi?UTC/s/0"
  lFirstString.s = "<td align=" + Chr(34) + "center" + Chr(34) + "><font size=" + Chr(34) + "7" + Chr(34) + " color=" + Chr(34) + "white" + Chr(34) + "><b>"
  lSecondString.s = "<br>"
  lThirdString.s = "</b></font><font size=" + Chr(34) + "5" + Chr(34) + " color=" + Chr(34) + "white" + Chr(34) + ">"
  lFourthString.s = "<br>"

  lUrlResult.s = OpenUrl(lUrl.s,1)
  lUrlResult.s = Trim(lUrlResult.s)
  
  If (Len(lUrlResult.s) > 0)
    lTime.s = Trim(ParseTagValue(lUrlResult.s,lFirstString.s,lSecondString.s))
    lParseResult.s = Trim(ParseTagValue(lUrlResult.s,lThirdString.s,lFourthString.s))
    ;Debug lTime.s
    ;Debug lParseResult.s
    
    If ((Len(lTime.s) > 0) And (Len(lParseResult.s)))
      lDow.s = Left(lParseResult.s,3)
      lMonth.s = Left(StringField(lParseResult.s,2," "),3)
      lDay.s = Trim(StringField(lParseResult.s,3," "))
      lDay.s = Mid(lDay.s,1,Len(lDay.s) - 1)
      lYear.s = Trim(StringField(lParseResult.s,4," "))
      
      lRetVal.s = lDow.s + ", " + lDay.s + " " + lMonth.s + " " + lYear.s + " "  + lTime.s + " -0000"
    
    EndIf
        
  EndIf
  
  ProcedureReturn lRetVal.s
EndProcedure

Debug GetUTC()
Cheers!

Re: SMTP AUTH example

Posted: Thu Jul 22, 2010 4:39 pm
by doctorized
I tried clipper's code to send mail with attachments with both x86 and x64 PB 4.50.
Can somebody tell me why the code returns error: "The Output Length should be at least 33% more than the InputLength."
in some file cases like the following:

Code: Select all

Global ConnectionID.l 


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

CreateFile(0,"c:\dda.txt")
WriteString(0,"Service StartUp")
CloseFile(0)

Global NewList Attachments.s() 
InsertElement(Attachments()) 
Attachments() = "c:\dda.txt" 

Declare.s Base64Encode(strText.s) 
Declare SendFiles() 
Declare.s GetMIMEType(Extension.s) 
Declare Send(msg.s) 
Declare.s SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s) 



;Sending Mail with SMTP-AUTH 
sendesmtpmail("Clipper","my@email.com","your@email.com","","","smtp.mailserver.com","Hallo","This is the body")


; Don΄t fill the Username if you want to sent regular 
;sendesmtpmail("Clipper","my@email.com","your@email.com","","","smtp.mailserver.com","Hallo","This is the body") 

Procedure.s SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s) 
	tmp.s
    If InitNetwork() 
       ConnectionID = OpenNetworkConnection(smtpserver, 25) 
       If ConnectionID 
          loop250.l=0 
          Repeat    
             If NetworkClientEvent(ConnectionID) 
                ReceivedData.s=Space(256) 
                ct=ReceiveNetworkData(ConnectionID ,@ReceivedData,256) 
                If ct 
                   cmdID.s=Left(ReceivedData,3) 
                   cmdText.s=Mid(ReceivedData,5,ct-6) 
                   Debug "<" + cmdID + " " + cmdText 
                   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", "535"
                            tmp = "error"
                         quit=1      
                   EndSelect 
                EndIf 
             EndIf 
              
          Until Quit = 1 
          CloseNetworkConnection(ConnectionID) 
          If tmp="":tmp="SUCCESS":EndIf
          ProcedureReturn tmp
       Else
       	ProcedureReturn "error"
       EndIf 
    EndIf
EndProcedure 

Procedure Send(msg.s) 
    ;Delay(10) 
    Debug "> " + msg 
    msg+#CRLF$ 
    SendNetworkData(ConnectionID, @msg, Len(msg)) 
EndProcedure 


Procedure SendFiles() 
    ResetList(Attachments()) 
    While(NextElement(Attachments())) 
    file.s=Attachments() 
    Send("") 
    If ReadFile(0,file.s) 
       Debug file 
       InputBufferLength.l = Lof(0) 
       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(0, *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(*memin) 
       FreeMemory(*memout) 
       CloseFile(0) 
    EndIf 
    Wend 
    ProcedureReturn 
EndProcedure 


Procedure.s Base64Encode(strText.s) 
    Define.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(*B64EncodeBufferA) 
    FreeMemory(*B64EncodeBufferB) 
    ProcedureReturn Result 
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

Re: SMTP AUTH example

Posted: Fri Jul 23, 2010 11:46 am
by doctorized
My problem seems to be solved in some cases with the following change:

Code: Select all

Global ConnectionID.l 


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

CreateFile(0,"c:\test.txt")
WriteStringN(0,"tester text")
CloseFile(0)

Global NewList Attachments.s() 
InsertElement(Attachments()) 
Attachments() = "c:\test.txt" 

Declare.s Base64Encode(strText.s) 
Declare SendFiles() 
Declare.s GetMIMEType(Extension.s) 
Declare Send(msg.s) 
Declare.s SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s) 

; Don΄t fill the Username if you want to sent regular 
debug sendesmtpmail("Clipper","my@email.com","your@email.com","","","smtp.mailserver.com","Hallo","This is the body") 

Procedure.s SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s) 
	tmp.s
    If InitNetwork() 
       ConnectionID = OpenNetworkConnection(smtpserver, 25) 
       If ConnectionID 
          loop250.l=0 
          Repeat    
             If NetworkClientEvent(ConnectionID) 
                ReceivedData.s=Space(256) 
                ct=ReceiveNetworkData(ConnectionID ,@ReceivedData,256) 
                If ct 
                   cmdID.s=Left(ReceivedData,3) 
                   cmdText.s=Mid(ReceivedData,5,ct-6) 
                   Debug "<" + cmdID + " " + cmdText 
                   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", "535"
                            tmp = "error"
                         quit=1      
                   EndSelect 
                EndIf 
             EndIf 
              
          Until Quit = 1 
          CloseNetworkConnection(ConnectionID) 
          If tmp="":tmp="SUCCESS":EndIf
          ProcedureReturn tmp
       Else
       	ProcedureReturn "error"
       EndIf 
    EndIf
EndProcedure 

Procedure Send(msg.s) 
    ;Delay(10) 
    Debug "> " + msg 
    msg+#CRLF$ 
    SendNetworkData(ConnectionID, @msg, Len(msg)) 
EndProcedure 


Procedure SendFiles() 
    ResetList(Attachments()) 
    While(NextElement(Attachments())) 
    file.s=Attachments() 
    Send("") 
    If ReadFile(0,file.s) 
       Debug file 
       InputBufferLength.l = Lof(0) 
       ;If InputBufferLength < 64: InputBufferLength = 64: EndIf
       OutputBufferLength.l = InputBufferLength * 1.4 
       If OutputBufferLength < 80: OutputBufferLength = 80: EndIf
       *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(0, *memin,InputBufferLength) 
             send(Base64Encode(PeekS(*memin)))
             ;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(*memin) 
       FreeMemory(*memout) 
       CloseFile(0) 
    EndIf 
    Wend 
    ProcedureReturn 
EndProcedure 


Procedure.s Base64Encode(strText.s) 
    Define.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(*B64EncodeBufferA) 
    FreeMemory(*B64EncodeBufferB) 
    ProcedureReturn Result 
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
This code seems to work fine if the last line in file has been created with WriteString(). If WriteStringN() has been used, then the recieved file has some rubbish in the last line. Can this code be trusted?
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited