■ Le code et sa zone de test à la fin pour envoyer un mail html.
Code : Tout sélectionner
;
; 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
;
;-Zone de test
Global MailSMTP.s, MailFrom.s, MailTo.s, MailSubject.s, MailMessageTEXT.s, MailMessageHTML.s
Global File.i, FileHTML.s
; Setup
MailSMTP = "" ;Serveur smtp : Exemple smtp.numericable.fr
MailFrom = " @ " ;Adresse email expéditeur
MailTo = " @ " ;Adresse email destinataire
MailSubject = "Annonce"
MailMessageTEXT = "" ;facultatif
FileHTML = "test.html" ;le fichier html à envoyer
File = ReadFile(#PB_Any, FileHTML)
While Eof(File) = 0
MailMessageHTML + ReadString(File)
Wend
CloseFile(File)
InitNetwork()
connection = smtp_open_server("smtp.numericable.fr", 25)
If connection
Debug smtp_easy_send_message(connection, MailFrom, MailTo, MailSubject, MailMessageTEXT, MailMessageHTML)
smtp_close_server(connection)
EndIf
N'oublie pas le setup
J'ai fait des tests et inclure un style CSS dans un message html ne fonctionne pas correctement. La mise en page ne correspond plus voir même si c'est une adresse gmail, la description css est supprimé par google.
La solution serait une codification Old Scool avec des tableaux (
HouuUUUUUUuuuu diront certains et j'en fait partie 
) On peut toutefois inclure du style à l'intérieur des balises html (
Allez encore des HouuuUUUUuu ..... ha ha ha)
■ Ci-dessous un truc vite fait en html que tu sauvegarderas dans le même dossier que le code plus haut sous le nom de
test.html.
Code : Tout sélectionner
<html>
<head>
</head>
<body style="font-family:georgia,serif; background-color:#E2D89A">
<center>
<table border="0" cellpadding="1" cellspacing="1" style="width: 500px;">
<tbody>
<tr>
<td>
<p style="font-size:36px;">Pure Basic 5.20 LTS</p>
<p style="color:#ff8c00; font-size:22px;">RockStar Release</p>
<br />
</td>
</tr>
<tr>
<td style="font-family:georgia,serif; font-size:18px;">
<p>Nous somme heureux de vous annoncer Pure Basic 5.20 LTS disponible dans votre espace client.</p><br />
</td>
</tr>
<tr>
<td>
<p style="text-align:center; background-color:#1b9596;border-radius:15px; padding-bottom:15px; padding-top:15px; padding-left:20px; padding-right:20px; margin-left: 120px; width: 207px;">
<a style="text-decoration:none; color:#ffffff; font-Size:21px" href="http://purebasic.com/securedownload/Login.php?language=FR" target="_blank"><em>Pure Basic 5.20</em></a>
</p>
</td>
</tr>
<tr>
<td>
<br /><hr />
<p style="text-align: center;">Vous recevez cet email parce que vous êtes client de purebasic.com</p>
</td>
</tr>
</tbody>
</table>
</body>
</html>
■ Résultat dans un email
