unit: MAPIBestBody.pas
file path: ..\Library\
version: 2014.хх
uses ActiveX, Classes, SHDocVw, ExtendedMAPI, IMIEMTypes
Available functions:
function GetBody - Returns the message text, the plain text body, as WideString
function GetBestBody - Returns the text of the message in the best possible format - HTML, RTF or Plain text
function GetBestBodyFormat - Determines the best format of a message body as Plain Text, RTF, HTML, etc..
procedure LoadBlankDoc - Clears the web browser window and "reset" it
procedure LoadDocFromStream - Used to load HTML content from a stream using the WebBrowser control
procedure LoadDocFromString - Loads HTML content from a string using the TWebBrowser control.
procedure SaveDocToStream - Saves TWebBrowser HTML content to a stream.
procedure CreateMimeMessage - Converts the contents of the message to MIME formatted file and displays its content in TWebBrowser control
function IsMIMEMessage - Detects whether the body of the message is in MIME format
function CPID2MIME - Converts CodePage ID to CodePage name
procedure CheckDocReady - For internal use.
procedure DecodeRtfHtml - Retrieves the encapsulated HTML into RTF
function GetBody(const MAPIMessage: IMessage): WideString;
description
Returns Plain Text Body (PR_BODY) as WideString
parameters
MAPIMessage - IMessage
function GetBestBodyFormat(const MAPIMessage: IMessage): TMsgBodyType;
description
Determines the best format of a message body as Plain Text, RTF, HTML, etc..
parameters
MAPIMessage - IMessage
function GetBestBody(const MAPIMessage: IMessage; out BodyType: TMsgBodyType): WideString;
description
Returns Best Body as WideString
parameters
MAPIMessage - IMessage
BodyType - TMsgBodyType. Expected type
of text body, as Plain Text, RTF, HTML, etc...
usage
procedure GetMsgBody;
var
BodyText: string;
BodyType: TMsgBodyType;
InetCodePage: Integer;
begin
if not Assigned(MAPIMessage) then
Exit;
BodyText := GetBestBody(MAPIMessage, BodyType);
InetCodePage := GetPropLong(MAPIMessage, PR_INTERNET_CPID);
if InetCodePage = 0 then
InetCodePage := 65001; // UTF-8
if BodyType in [aHtml, aRtfToHml] then
begin
RichEdit.Visible := False;
WebBrowser.Visible := True;
LoadDocFromString(WebBrowser, BodyText, InetCodePage);
end
else // BodyType
is Plain Text or RTF
begin
WebBrowser.Visible := False;
RichEdit.Visible := True;
RichEdit.Lines.LoadFromStream(TStringStream.Create(BodyText));
end;
end;
procedure LoadBlankDoc(WB: TWebBrowser);
description
Loads "blank" page (clears TWebBrowser content)
procedure LoadDocFromStream(WB: TWebBrowser; Stream: TStream);
description
Loads HTML content from a stream using the TWebBrowser control. Uses internally
the IPersistStreamInit Interface
parameters
WB - TWebBrowser
Stream - TStream with valid HTML content
usage
// Load a body from file - plain text, rtf, html
procedure LoadFromFile;
var
FileName: string;
Filter: string;
FileStream: TFileStream;
begin
case rgBody.ItemIndex of
// rgBody is RadioGroup
0: Filter := 'HTML
files|*.HTML;*.HTM';
1: Filter := 'Text files
(*.txt)|*.TXT';
2: Filter := 'Rich Text files
(*.rtf)|*.RTF';
end;
if not PromptForFileName(FileName, Filter,
'', 'Please select a file', ExtractFilePath(Application.ExeName)) then
Exit;
FileStream := TFileStream.Create(FileName, fmOpenRead or
fmShareDenyWrite);
try
case
rgBody.ItemIndex of
0:
// HTML
begin
Memo.Visible := False;
RichEdit.Visible := False;
LoadDocFromStream(WebBrowser, FileStream);
WebBrowser.Visible := True;
end;
1:
// Plain Text
begin
RichEdit.Visible := False;
WebBrowser.Visible := False;
Memo.Visible := True;
Memo.Lines.LoadFromStream(FileStream);
end;
2:
// RTF
begin
RichEdit.Visible := True;
WebBrowser.Visible := False;
Memo.Visible := False;
RichEdit.PlainText := False;
RichEdit.Lines.LoadFromStream(FileStream);
end;
end;
finally
if Assigned(FileStream)
then
FreeAndNil(FileStream);
end;
end;
procedure LoadDocFromString(WB: TWebBrowser; const HTMLString: WideString; const CodePage: Integer = 0);
description
Loads HTML content from a string using the TWebBrowser control. Uses internally
the IHTMLDocument2 Interface
parameters
WB - TWebBrowser
HTMLString - WideString with valid HTML content
CodePage - sets the IHTMLDocument2 character set used to encode text.
usage
procedure GetHTMLBodyRendered;
var
Stream: TStream;
StrStream: TStream;
CodePage: ULONG;
begin
Stream := nil;
try
WebBrowser.Visible := True;
if
GetMsgBodyHTML(FMAPIMessage, Stream) then
begin
CodePage :=
GetMsgInetCodePage(FMAPIMessage);
StrStream :=
TStringStream.Create('', TEncoding.GetEncoding(CodePage));
try
TMemoryStream(Stream).SaveToStream(StrStream);
StrStream.Position := 0;
InitializeCIDMIMEHandler(FMAPIMessage);
LoadDocFromString(WebBrowser, TStringStream(StrStream).DataString,
CodePage);
FreeCIDMIMEHandler;
finally
FreeAndNil(StrStream);
end;
end;
finally
if Assigned(Stream)
then
FreeAndNil(Stream);
end;
end;
procedure SaveDocToStream(WB: TWebBrowser; Stream: TStream);
description
Saves TWebBrowser HTML content to a stream. Uses internally the IPersistStreamInit Interface
parameters
WB - TWebBrowser
Stream - TStream
usage
Stream := TMemoryStream.Create;
try
SaveDocToStream(WebBrowser, Stream);
if Stream.Size > 0 then
SetMsgBodyHtml(FMAPIMessage, Stream);
finally
FreeAndNil(Stream);
end;
procedure CreateMimeMessage(const MAPIMessage: IMessage; const MsgBody: String; WB: TWebBrowser; const CodePage: Integer = 0);
description
For internal use. Renders IMessage inside
TWebBrowser. Please see our example
"What is the Best Body?" for
possible usage.
usage
MsgBody := GetBestBody(MAPIMessage, BodyType);
if BodyType in [aHTML .. aRtfToHml] then
begin
CodePage := 0;
if FPropExists(MAPIMessage, PR_INTERNET_CPID) then
CodePage := GetPropLong(MAPIMessage, PR_INTERNET_CPID);
if IsMIMEMessage(MsgBody) then
CreateMimeMessage(MAPIMessage, MsgBody, WebBrowser, CodePage)
else
begin
LoadDocFromString(WebBrowser, MsgBody, CodePage);
end;
end;
function IsMIMEMessage(const MsgBody: String): Boolean;
description
For internal use. See example above.
function CPID2MIME(const CodePage: Integer = 0): String;
description
Convert body
usage
if (CodePage <> 0) then
begin
sCharset := WideString(CPID2MIME(CodePage));
HTMLDocument.charset := sCharset;
end;
procedure CheckDocReady(WB: TWebBrowser);
description
For internal use.
procedure DecodeRtfHtml(buffer: PChar);
description
Retrieves the encapsulated HTML into RTF message body.
parameters
buffer: PChar - Buffer containing RTF text that contains encapsulated HTML, and as an output - the converted HTML.
Copyright © 2021 IMIBO
Privacy Statement |