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