How to send TRichView document as formatted e-mail
This example uses TNMSMTP component
In the same demo, add the new function returning MIME-encoded document as string.
As you can see, there are 2 main differences comparing to the original file saving procedure from the demo:
1) headers are not included
2) not only HTML+images, but a plain text alternative is included.
Code: Select all
uses RVUni;
function TForm1.GetEMail: String;
var Stream: TStringStream;
Stream2: TMemoryStream;
ws: WideString;
s, s2: String;
boundary: String;
i: Integer;
begin
// saving text
HTMLImages.Clear;
Stream2 := TMemoryStream.Create;
RichViewEdit1.SaveTextToStreamW('', Stream2, 80, False, False);
Stream2.Position := 0;
SetLength(ws, Stream2.Size div 2);
if Stream2.Size<>0 then
Stream2.ReadBuffer(Pointer(ws)^, Stream2.Size);
s2 := MimeEncodeString(Utf8Encode(ws));
Stream2.Free;
// saving HTML
Stream := TStringStream.Create('');
RichViewEdit1.SaveHTMLToStreamEx(Stream, '', 'Web Archive Demo', '', '', '', '',
[rvsoUseCheckpointsNames, rvsoUTF8]);
s := MimeEncodeString(Stream.DataString);
Stream.Free;
// now s contains HTML file without images, base64-encoded. saving it in MIME
boundary := '----=_BOUNDARY_LINE_';
Result :=
'This is a multi-part message in MIME format.'+CRLF+CRLF+
'--'+boundary+CRLF+
'Content-Type: text/plain;'+CRLF+
#9'charset="utf-8"'+CRLF+
'Content-Transfer-Encoding: base64'+CRLF+CRLF+
s2+CRLF+CRLF+
'--'+boundary+CRLF+
'Content-Type: text/html;'+CRLF+
#9'charset="utf-8"'+CRLF+
'Content-Transfer-Encoding: base64'+CRLF+CRLF+
s+CRLF;
// saving images
for i := 0 to HTMLImages.Count-1 do begin
s2 := CRLF+
'--'+boundary+CRLF;
SetLength(s, HTMLImages[i].Stream.Size);
HTMLImages[i].Stream.Position := 0;
HTMLImages[i].Stream.ReadBuffer(PChar(s)^, Length(s));
s := MimeEncodeString(s);
s2 := s2+'Content-Type: '+HTMLImages[i].ContentType+CRLF+
#9'Name="'+HTMLImages[i].Name+'"'+CRLF+
'Content-Transfer-Encoding: base64'+CRLF+
'Content-ID: <'+HTMLImages[i].Name+'>'+CRLF+CRLF+
s+CRLF;
Result := Result+s2;
end;
Result := Result+CRLF+'--'+boundary+'--'+CRLF;
HTMLImages.Clear;
end;
Sending:
Code: Select all
NMSMTP1.Host := ...;
NMSMTP1.Port := ...;
NMSMTP1.UserID := ...;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress := ...;
NMSMTP1.PostMessage.FromName := ...;
NMSMTP1.PostMessage.ToAddress.Text := ...;
NMSMTP1.PostMessage.ToCarbonCopy.Text := '';
NMSMTP1.PostMessage.ToBlindCarbonCopy.Text := '';
NMSMTP1.PostMessage.Body.Text := GetEMail;
NMSMTP1.PostMessage.Attachments.Text := '';
NMSMTP1.PostMessage.Subject := 'HTML Test';
NMSMTP1.PostMessage.LocalProgram := 'Demo HTML Mailer';
NMSMTP1.PostMessage.Date := '';
NMSMTP1.PostMessage.ReplyTo := ...;
NMSMTP1.SendMail;
The main trick is in adding headers in NMSMTP1.OnSendStart:
Code: Select all
procedure TForm1.NMSMTP1SendStart(Sender: TObject);
begin
NMSMTP1.FinalHeader.Add('MIME-Version: 1.0');
NMSMTP1.FinalHeader.Add('Content-Type: multipart/alternative;');
NMSMTP1.FinalHeader.Add(#9'boundary="----=_BOUNDARY_LINE_"');
end;
That's all.
Please do not abuse this feature.
