PureBasic Forums - English

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

How to send Html-Emails with PB?

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

Page 1 of 1

How to send Html-Emails with PB?

Posted: Tue Aug 21, 2012 8:49 am
by dige
I'd like to send a html email with alternate plain text.
To do this, I have to create an multipart message
with type: multipart/alternative like this structure:

Code: Select all

multipart/alternative
 |
 +-- text/plain
 |
 +-- text/html
I've tried it in this way, but all parts are shown as attachment,
not as email message:

Code: Select all

If InitNetwork()
  
  If CreateMail(0, "myemail@myhost.org", "TestNachricht"  )
    SetMailAttribute(0, #PB_Mail_XMailer, "PB mail library" )
    AddMailRecipient(0, "customer@somehost.org", #PB_Mail_To)
    AddMailAttachmentData( 0, "Plain Text", ?plain_text, ?html_text-?plain_text, "text/plain" )
    AddMailAttachmentData( 0, "Newsletter.html", ?html_text, ?end_data-?html_text, "text/html" )
    Result = SendMail(0, "127.0.0.1", 25, #Null)

    Repeat
      Select MailProgress(0)
        Case #PB_Mail_Connected : Debug "Conected"
        Case #PB_Mail_Error     : Debug "Error" : Break
        Case #PB_Mail_Finished  : Debug "Finished" : Break
      EndSelect
      Delay(300)
    ForEver
    
    FreeMail(0)
  EndIf
EndIf

DataSection
  plain_text: Data.s "Your email client does not support html"
  html_text:  Data.s "<html><head><title>Newsletter</title></head><body><h1>Message</h1></body></html>"
  end_data:
EndDataSection
Anyone can help?

Re: How to send Html-Emails with PB?

Posted: Tue Aug 21, 2012 10:20 am
by infratec
Hi dige,

with PB direct it's not possible.

I modified a sourcecode from 'unknown' to allow multipart html e-mails:

Code: Select all

;
; original code from ???
;
; extended for html multipart by infratec
;


#SMTP_BufferLength = 2048

Global *SMTPBuffer          = AllocateMemory(#SMTP_BufferLength)
Global SMTP_LastAnswer$     = "" ; the last answer of the pop3-server
Global SMTP_Last_Error      = 0  ; the last occurred error

Enumeration
 #SMTP_OK
 #SMTP_NoConnection
 #SMTP_No_Answer
 #SMTP_Refused
 #SMTP_Sender_Refused
 #SMTP_Receiver_Refused
 #SMTP_Send_Error
EndEnumeration

#SMTP_Helo    = "HELO "       ; Zum Anfragen an den Server
#SMTP_Mail    = "MAIL FROM:"  ; Zum Verschicken einer E-Mail, hier Absender
#SMTP_RCPT    = "RCPT TO:"    ; Zum Verschicken des Empfängers
#SMTP_Data    = "DATA"        ; Zu sendende Daten anhängen
#SMTP_Close_S = "QUIT"        ; Serververbindung schließen

Global Dim DayOfWeek_Eng.s(6) : DayOfWeek_Eng(0) = "Sun" : DayOfWeek_Eng(1) = "Mon" : DayOfWeek_Eng(2) = "Tue" : DayOfWeek_Eng(3) = "Wed" : DayOfWeek_Eng(4) = "Thu" : DayOfWeek_Eng(5) = "Fri" : DayOfWeek_Eng(6) = "Sat"
Global Dim Month_Eng.s(11)    : Month_Eng(0) = "Jan" : Month_Eng(1) = "Feb" : Month_Eng(2) = "Mar" : Month_Eng(3) = "Apr" : Month_Eng(4) = "May" : Month_Eng(5) = "Jun" : Month_Eng(6) = "Jul" : Month_Eng(7) = "Aug" : Month_Eng(8) = "Sep" : Month_Eng(9) = "Oct" : Month_Eng(10) = "Nov" : Month_Eng(11) = "Dec"

; Send order to Server

Procedure.l SMTP_Send_Server(Connection, Query$) ; OK - geprüft
 SMTP_Last_Error  = #SMTP_Refused
 SendNetworkString(Connection, Query$)
 Result = ReceiveNetworkData(Connection, *SMTPBuffer, #SMTP_BufferLength)
 If Result <> 0
  SMTP_LastAnswer$ = PeekS(*SMTPBuffer, Result)
  If FindString(SMTP_LastAnswer$, "250", 0) Or FindString(SMTP_LastAnswer$, "354", 0)
   SMTP_Last_Error  = #SMTP_OK 
  EndIf
 EndIf
 ProcedureReturn SMTP_Last_Error
EndProcedure

; Open connection to server

Procedure.l SMTP_Open_Server(Server$, PortNumber) ; OK - geprueft
 SMTP_Last_Error = 0
 SMTP_LastAnswer$ = ""
 Connection = OpenNetworkConnection(Server$, PortNumber, #PB_Network_TCP)
 If Connection = 0
  SMTP_Last_Error = #SMTP_NoConnection
 Else
  Result = ReceiveNetworkData(Connection, *SMTPBuffer, #SMTP_BufferLength)
  If Result = 0
   SMTP_Last_Error = #SMTP_No_Answer
  Else
   SMTP_LastAnswer$ = PeekS(*SMTPBuffer, Result)
   Position         = FindString(SMTP_LastAnswer$, " ", 0) + 1
   NewServer$       = Mid(SMTP_LastAnswer$, Position, FindString(SMTP_LastAnswer$, " ", 5) - Position)
   If FindString(SMTP_LastAnswer$, "220", 0) <> 0
    SMTP_Last_Error = SMTP_Send_Server(Connection, #SMTP_Helo + NewServer$ + #CRLF$) = #SMTP_OK
    ProcedureReturn Connection
   EndIf   
  EndIf
 EndIf
 ProcedureReturn 0
EndProcedure

; Send Message$ From$ ToWhom$ with Subject$, Copies go ToCC$ or ToBCC$ (hidden)

Procedure.l SMTP_Easy_Send_Message(Connection, From$, ToWhom$, Subject$, Message$, HTML$ = "", ToCC$ = "", ToBCC$ = "") ; OK - geprueft
  Mail$ + "Date: " + DayOfWeek_Eng(DayOfWeek(Date())) + ", " + Str(Day(Date())) + " " + Month_Eng(Month(Date())) + " " + Str(Year(Date()))
  Mail$ + " " + Str(Hour(Date())) + ":" + Str(Minute(Date())) + ":" + Str(Second(Date())) + " +0200" + #CRLF$
  
  Mail$ = "From: "+ From$ + #CRLF$
  
  If ToWhom$ : Mail$ + "To: " + ToWhom$ + #CRLF$ : EndIf
  If ToCC$   : Mail$ + "cc: " + ToCC$ + #CRLF$   : EndIf
  If ToBCC$  : Mail$ + "Bcc: " + ToBCC$ + #CRLF$ : EndIf
  
  MaiL$ + "Subject: " + Subject$ + #CRLF$
 
 
 Mail$ + "MIME-Version: 1.0" + #CRLF$
 If HTML$
   Mail$ + "Content-Type: multipart/alternative; boundary=" + #DQUOTE$ + "==Boundary_XYZ" + #DQUOTE$ + #CRLF$
   Mail$ + "--==Boundary_XYZ" + #CRLF$
   Mail$ + "Content-Type: text/plain; charset=iso-8859-1" + #CRLF$
   Mail$ + "Content-Transfer-Encoding: 8bit" + #CRLF$
   Mail$ + #CRLF$
   Mail$ + Message$ + #CRLF$
   Mail$ + #CRLF$
   Mail$ + "--==Boundary_XYZ" + #CRLF$
   Mail$ + "Content-Type: text/html; charset=iso-8859-1" + #CRLF$
   Mail$ + "Content-Transfer-Encoding: 8bit" + #CRLF$
   Mail$ + #CRLF$
   Mail$ + HTML$ + #CRLF$
   Mail$ + #CRLF$
   Mail$ + "--==Boundary_XYZ--" + #CRLF$
 Else
   Mail$ + "Content-type: text/plain; charset=iso-8859-1" + #CRLF$
   Mail$ + "Content-Transfer-Encoding: 8bit" + #CRLF$
   Mail$ + Message$ + #CRLF$
 EndIf
 
 Mail$ + "." + #CRLF$
 
 Debug Mail$
 
 If SMTP_Send_Server(Connection, #SMTP_Mail + From$ + #CRLF$) = 0
  If SMTP_Send_Server(Connection, #SMTP_RCPT + ToWhom$ + #CRLF$) = 0
   If SMTP_Send_Server(Connection, #SMTP_Data + #CRLF$) = 0
    If SMTP_Send_Server(Connection, Mail$) = 0
     SMTP_Last_Error = #SMTP_OK
    Else
     SMTP_Last_Error = #SMTP_Send_Error 
    EndIf
   Else
    SMTP_Last_Error = #SMTP_Send_Error 
   EndIf
  Else
   SMTP_Last_Error = #SMTP_Sender_Refused 
  EndIf
 Else
  SMTP_Last_Error = #SMTP_Receiver_Refused
 EndIf
 ProcedureReturn SMTP_Last_Error
EndProcedure

; Close connection to server

Procedure.l SMTP_Close_Server(Connection) ; OK - geprueft
 ProcedureReturn SMTP_Send_Server(Connection, #SMTP_Close_S + #CRLF$)
EndProcedure

; quick and dirty hack
InitNetwork()
connection = smtp_open_server("your smtp-server.com", 25)
If connection
  Debug smtp_easy_send_message(connection, "your-user-name", "your receiver (leave blank)", "Test", "Testmessage", "<html><head><title>Newsletter</title></head><body><h1>Test</h1></body></html>")
  smtp_close_server(connection)
EndIf
Bernd

Re: How to send Html-Emails with PB?

Posted: Tue Aug 21, 2012 11:53 am
by dige
@infratec: well done! it works :-D thx!!!

Re: How to send Html-Emails with PB?

Posted: Tue Aug 21, 2012 1:55 pm
by infratec
Hi,

I added my code to the mail program from here
http://www.purebasic.fr/english/viewtop ... 79#p388479

It is more flexible.

Bernd

Re: How to send Html-Emails with PB?

Posted: Wed Aug 22, 2012 7:49 am
by Shardik
infratec wrote:I modified a sourcecode from 'unknown' to allow multipart html e-mails:
The original author was jamirokwai and he posted it here:
http://www.purebasic.fr/english/viewtop ... 12&t=33457

Re: How to send Html-Emails with PB?

Posted: Sat Jul 14, 2018 9:15 am
by PHP
Is there no way to send a HTML mail with the existing PB functions?

Thought SetMailAttribute() can do this?

Re: How to send Html-Emails with PB?

Posted: Sat Jul 14, 2018 12:57 pm
by Dude
PHP wrote:Thought SetMailAttribute() can do this?
Nope.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited