Parse Email Body, Attachment and Convert Email to HTML page in Delphi¶

unit Unit1;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, StrUtils, EAGetMailObjLib_TLB;

type
    TForm1 = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
    private
        { Private declarations }
        procedure ConvertMailToHtml(fileName: WideString);
        procedure GenerateHtmlForEmail(emlFile: WideString; htmlFile: WideString; attachmentFolder: WideString);
        function FormatAddresses(addresses: IAddressCollection; prefix: WideString): WideString;
    public
        { Public declarations }
    end;

const
    CRYPT_MACHINE_KEYSET = 32;
    CRYPT_USER_KEYSET = 4096;
    CERT_SYSTEM_STORE_CURRENT_USER = 65536;
    CERT_SYSTEM_STORE_LOCAL_MACHINE = 131072;

Var
    Form1: TForm1;

Implementation

{$R *.dfm}

procedure TForm1.ConvertMailToHtml(fileName: WideString);
var
    htmlFile, attachmentFolder: WideString;
    oTools: TTools;
begin
    // Remove .eml extension
    htmlFile := LeftStr(fileName, length(fileName) - 4) + '.htm';
    attachmentFolder := LeftStr(fileName, length(fileName) - 4);

    oTools := TTools.Create(Application);
    if not oTools.ExistFile(htmlFile) then
        begin
            // We haven't generate the html for this email, generate it now.
            GenerateHtmlForEmail(fileName, htmlFile, attachmentFolder);
        end;

end;

procedure TForm1.GenerateHtmlForEmail(emlFile: WideString; htmlFile: WideString; attachmentFolder: WideString);
var
    oMail: TMail;
    oTools: TTools;
    attachments: IAttachmentCollection;
    oAttachment: IAttachment;
    i: integer;
    html, header, attachmentName: WideString;
begin
    oTools := TTools.Create(Application);
    oMail := TMail.Create(Application);
    oMail.LicenseCode := 'TryIt';

    oMail.LoadFile(emlFile, false);

    try
        if oMail.IsEncrypted then
            oMail.Load(oMail.Decrypt(nil).Content);
    except
        on ep:Exception do
            ShowMessage('Decrypt Error: ' + ep.Message);
    end;

    try
        if oMail.IsSigned then
            oMail.VerifySignature();
    except
        on ep:Exception do
            ShowMessage('Verify Digital Signature Error: ' + ep.Message);
    end;

    // Decode winmail.dat (TNEF stream) automatically.
    // also convert RTF body to HTML automatically.
    oMail.DecodeTNEF();

    html := oMail.HtmlBody;
    header := header + '<font face="Courier New,Arial" size="2">';
    header := header + '<b>From:</b> ' + oMail.From.Name + ' &lt;' + oMail.From.Address + '&gt;' + '<br>';

    header := header + FormatAddresses(oMail.ToList, 'To');
    header := header + FormatAddresses(oMail.CcList, 'Cc');
    header := header + '<b>Subject:</b>' + oMail.Subject + '<br>' + #13#10;

    // Parse attachment
    attachments := oMail.AttachmentList;
    if(attachments.Count > 0) then
        begin
            // Create a temporal folder to store attachments.
            if not oTools.ExistFile(attachmentFolder) then
                oTools.CreateFolder(attachmentFolder);

            header := header + '<b>Attachments:</b> ';
            for i:= 0 to attachments.Count - 1 do
                begin
                    oAttachment := attachments.Item[i];

                    attachmentName := attachmentFolder + '\' + oAttachment.Name;
                    oAttachment.SaveAs(attachmentName, true);
                    header := header + '<a href="' + attachmentName + '" target="_blank">' + oAttachment.Name + '</a> ';

                        // Show embedded images
                    if oAttachment.ContentID <> '' then
                        begin
                            // StringReplace doesn't support some non-ascii characters very well.
                            html := StringReplace(html, 'cid:' + oAttachment.ContentID, attachmentName, [rfReplaceAll, rfIgnoreCase]);
                        end
                end;
        end;

    header := '<meta http-equiv="Content-Type" content="text-html; charset=utf-8">' + header;
    html := header + '<hr>' + html;
    oTools.WriteTextFile(htmlFile, html, 65001);

end;

function TForm1.FormatAddresses(addresses: IAddressCollection; prefix: WideString): WideString;
var
    value: WideString;
    i: integer;
begin
    if addresses.Count = 0 then
    begin
        result := '';
        exit;
    end;

    value := '<b>' + prefix + ':</b> '; // To or Cc

    for i := 0 to addresses.Count - 1 do
        begin
            if(addresses.Item[i].Name = '') then
            value := value + '&lt;' + addresses.Item[i].Address + '&gt;'
            else
            value := value + addresses.Item[i].Name + ' &lt;' + addresses.Item[i].Address + '&gt;';

            if (i < addresses.Count - 1) then
                value := value + '; ';
        end;

    result := value + '<br>';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    try
        ConvertMailToHtml('c:\my folder\test.eml');
    except
        on ep:Exception do
            ShowMessage('Error: ' + ep.Message);
    end;

end;

end.