SMTP AUTH example

Just starting out? Need help? Post your questions and find answers here.
Post Reply
zikitrake
Addict
Addict
Posts: 868
Joined: Thu Mar 25, 2004 2:15 pm
Location: Spain

Post 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!
PB 6.21 beta, PureVision User
Top
fweil
Enthusiast
Enthusiast
Posts: 725
Joined: Thu Apr 22, 2004 5:56 pm
Location: France
Contact:
Contact fweil

Post 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.
My avatar is a small copy of the 4x1.8m image I created and exposed at 'Le salon international du meuble à Paris' january 2004 in Matt Sindall's 'Shades' designers exhibition. The original laminated print was designed using a 150 dpi printout.
Top
zikitrake
Addict
Addict
Posts: 868
Joined: Thu Mar 25, 2004 2:15 pm
Location: Spain

Post by zikitrake »

fweil thank you; I'll try your code tomorrow
PB 6.21 beta, PureVision User
Top
Straker
Enthusiast
Enthusiast
Posts: 701
Joined: Wed Apr 13, 2005 10:45 pm
Location: Idaho, USA

Re: SMTP AUTH example

Post 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!
Image Image
Top
User avatar
doctorized
Addict
Addict
Posts: 882
Joined: Fri Mar 27, 2009 9:41 am
Location: Athens, Greece

Re: SMTP AUTH example

Post 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
Top
User avatar
doctorized
Addict
Addict
Posts: 882
Joined: Fri Mar 27, 2009 9:41 am
Location: Athens, Greece

Re: SMTP AUTH example

Post 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?
Top
Post Reply

Return to “Coding Questions”