delphi 如何通过电子邮件正确发送嵌入的base64图像(HTML)?

vm0i2vca  于 2023-06-22  发布在  其他
关注(0)|答案(2)|浏览(362)

我想使用Indy发送带有嵌入图像的电子邮件,对于这些情况,HTML模板必须具有base64转换的图像。
示例HTML模板:

<html>
  <head>
  </head>
  <body>
    <div>
      <p>Some text</p>
      <img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAUAAAAFCAYAAACNbyblAAAAHElEQVQI12P4
        //8/w38GIAXDIBKE0DHxgljNBAAO9TXL0Y4OHwAAAABJRU5ErkJggg==" alt="Red dot" />
    </div>
  </body>
</html>

这个HTML只是为了测试,但是即使使用这个简单的base64图像和纯文本,当我用Indy通过电子邮件发送它时,我也不能正确地接收图像。我收到的HTML代码,或文本与破碎的图像,或图像甚至不加载(带有一个空格)。
但是,当我在普通浏览器(即Chrome或Firefox)中打开HTML文件时,图像加载没有问题。
我尝试了以下例程:

uses
  idMessage, idText, IdSMTP, IdSSLOpenSSL, IdExplicitTLSClientServerBase;

procedure SendMail;
var
  html: TStringList;
  email: TIdMessage;
  idSMTP: TIdSMTP;
  idSSL: TIdSSLIOHandlerSocketOpenSSL;
begin
  html:= TStringlist.Create;
  html.LoadFromFile('<my_html_file>');

  email := TIdMessage.Create(nil);
  email.From.Text := 'from@mail.com';
  email.From.Name:= 'from name'; ///
  email.Recipients.EMailAddresses := 'recipient';

  email.Subject := 'From DELPHI';
  email.ContentType := 'multipart/mixed';  //email comes with HTML text
  //email.ContentType := 'text/html';  //email comes with plain text, but not images
  email.Body.Assign(html);

  // SSL stuff //
  idSSL:= TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  idSSL.SSLOptions.Mode:= sslmClient;
  idSSL.SSLOptions.Method:= sslvSSLv23;

  // SMTP stuff //
  idSMTP:= TIdSMTP.Create(nil);
  idSMTP.IOHandler:= idSSL;
  idSMTP.Host:= 'smtp.office365.com';
  idSMTP.Port:=  587;
  idSMTP.AuthType := satDefault;
  //idSMTP.UseTLS:= utUseImplicitTLS;
  idSMTP.UseTLS:= utUseExplicitTLS;
  idSMTP.Username:= 'mail@mail.com';
  idSMTP.Password:=  'pass';

  try
    idSMTP.Connect();
    idSMTP.Send(email);
    ShowMessage('Sent');
  except
    on E: Exception do
    ShowMessage('Failed: ' + E.Message);
  end;
end;

我也尝试使用TIdMessageBuilderHtml,但在这个案例中没有成功。
我做错了什么?

jvidinwx

jvidinwx1#

通用的解决方案,使用图像的html部分的电子邮件,它的内置图像作为附件和使用附件ID作为SRC的图像。比如:

<img src="cid:2.jpg" alt="Red dot" />

在这种情况下,所有客户端邮件查看器必须显示电子邮件,因为它应该是。
这是我的旧项目的一部分,它将所有html图像添加到附件中,从“文件名”到相应的标识符。这不是最佳的来源,但你可以从中得到主要的信息。

uses
  IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
  IdMessageClient, IdSMTPBase, IdSMTP, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
  idMessage, IdAttachment,
  idText, IdAttachmentFile, math;

function HtmlDecode (const AStr: String): String;
begin
    Result := StringReplace(AStr,   '&apos;', '''', [rfReplaceAll]);    {Do not Localize}
    Result := StringReplace(Result, '&quot;', '"', [rfReplaceAll]);    {Do not Localize}
    Result := StringReplace(Result, '&gt;', '>', [rfReplaceAll]);    {Do not Localize}
    Result := StringReplace(Result, '&lt;', '<', [rfReplaceAll]);    {Do not Localize}
    Result := StringReplace(Result, '&amp;', '&', [rfReplaceAll]);    {Do not Localize}
end;

function IsXDigit(Ch : char) : Boolean;
begin
    Result := (ch in ['0'..'9']) or (ch in ['a'..'f']) or (ch in ['A'..'F']);
end;

function XDigit(Ch : char) : Integer;
begin
    if ch in ['0'..'9'] then
        Result := ord(Ch) - ord('0')
    else
        Result := (ord(Ch) and 15) + 9;
end;

function htoin(value : PChar; len : Integer) : Integer;
var
    i : Integer;
begin
  Result := 0;
  i      := 0;
  while (i < len) and (Value[i] = ' ') do
      i := i + 1;
  while (i < len) and (isxDigit(Value[i])) do begin
      Result := Result * 16 + xdigit(Value[i]);
      i := i + 1;
  end;
end;

function htoi2(value : PChar) : Integer;
begin
    Result := htoin(value, 2);
end;

function UrlDecode(S : String) : String;
var
    I  : Integer;
    Ch : Char;
begin
    Result := '';
    I := 1;
    while (I <= Length(S)) do begin
        Ch := S[I];
        if Ch = '%' then begin
            Ch := chr(htoi2(@S[I + 1]));
            Inc(I, 2);
        end
        else if Ch = '+' then
            Ch := ' ';
        Result := Result + Ch;
        Inc(I);
    end;
end;

procedure TForm3.HandleIMGID(ASourceDir: String;
  var AHTMString: String; AMessage: TIDMessage; AParentPart : integer = -1);
var
  IMGPos : Integer ;
  CurrentPoint : Pchar ;
  AFile : String ;
  AAttachment : TIdAttachment ;
begin
  CurrentPoint := pchar(AHTMString);
  IMGPos := 0 ;
  while pos('src="', CurrentPoint) <> 0 do begin
    IMGPos := IMGPos + pos('src="',CurrentPoint) + 4 ;
    CurrentPoint := pchar(AHTMString) + IMGPos ;
    if pos('"', CurrentPoint) <> 0 then begin
      AFile := copy(AHTMString, IMGPos + 1, pos('"', CurrentPoint) - 1);
      AFile := UrlDecode(afile) ;
      AFile := StringReplace(AFile, '/', '\', [rfReplaceAll]);
      if FileExists(IncludeTrailingBackslash(ASourceDir) + AFile) then
        AFile := IncludeTrailingBackslash(ASourceDir) + AFile;

      if FileExists(AFile) then begin
        AAttachment := TIdAttachmentFile.Create(AMessage.MessageParts, AFile);
        AAttachment.FileName := HtmlDecode(ExtractFileName(AFile));
        AAttachment.ContentType := 'image/jpeg';
        AAttachment.Headers.Add('Content-ID: <' + AAttachment.FileName + '>');
        AAttachment.ParentPart := AParentPart;
        delete(AHTMString, IMGPos + 1, pos('"', CurrentPoint) - 1);
        insert('cid:' + AAttachment.FileName, AHTMString, IMGPos + 1);
      end{if};
      CurrentPoint := CurrentPoint + min(pos('"', CurrentPoint), 0);
      AFile := '';
    end{if};
  end{while};
end;

procedure TForm3.Button1Click(Sender: TObject);
var
  s : string;
  xMessage : TIDMessage;
  APlainHTML, APlainText, ATextPart, AEmail : TIdText ;
begin
  IdSMTP1.Username := 'from@mail.com';
  IdSMTP1.Password := 'password';
  IdSMTP1.Port := 587;
  IdSMTP1.Host := 'hosturl.com';

  IdSMTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
  IdSMTP1.UseTLS := utUseExplicitTLS;
  IdSMTP1.Connect;

  xMessage := TIDMessage.Create(self) ;
  try
    //fill message attributes
    xMessage.From.Name := 'from@mail.com';
    xMessage.From.Address := 'from@mail.com';
    xMessage.Subject := 'Some test subject';

    //fill Recipients
    xMessage.Recipients.Clear ;

    xMessage.Recipients.EMailAddresses := 'recipient@gmail.com';

    xMessage.BccList.Clear;
    xMessage.ccList.Clear;

    //fill message content
    xMessage.ContentType := 'multipart/mixed';
    AEmail := TIdText.create(xMessage.MessageParts);
    AEmail.ContentType := 'multipart/related; type="multipart/alternative"';

    ATextPart := TIdText.create(xMessage.MessageParts);
    ATextPart.ContentType := 'multipart/alternative';
    ATextPart.ParentPart := 0;

    APlainText :=  TIdText.create(xMessage.MessageParts);
    APlainText.ContentType := 'text/plain';
    APlainText.Body.Text := 'Some plain text of mail';
    APlainText.ParentPart := ATextPart.Index;

    //load html
    APlainHTML := TIdText.create(xMessage.MessageParts);
    APlainHTML.ContentType := 'text/html';
    APlainHTML.ParentPart := ATextPart.Index;
    s :=  '<html>' + #13#10 +
          '  <head>' + #13#10 +
          '  </head>' + #13#10 +
          '  <body>' + #13#10 +
          '    <div>' + #13#10 +
          '      <p>Some text</p>' + #13#10 +
//            '      <img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAUAAAAFCAYAAACNbyblAAAAHElEQVQI12P4' + #13#10 +
//            '        //8/w38GIAXDIBKE0DHxgljNBAAO9TXL0Y4OHwAAAABJRU5ErkJggg==" alt="Red dot" />' + #13#10 +
          '      <img src="2.jpg" alt="Red dot" />' + #13#10 +
          '    </div>' + #13#10 +
          '  </body>' + #13#10 +
          '</html>';
    HandleIMGID('C:\temp', s, xMessage, 0);
//    HandleIMGID(FSettings.TeplateFolder, s, xMessage, 0);
    APlainHTML.Body.Text := s;

    if IdSMTP1.Authenticate then begin
      IdSMTP1.Send(xMessage);
    end;
  finally
    xMessage.Free;
  end;
end;

P.S.所有来自附件的图像将不会显示为附加文件,如果它的HTML部分使用。

mpgws1up

mpgws1up2#

正如我前面提到的,我的想法是(并且是)类似于@Oleksandr Morozevych的答案,我基本上将base64中的所有图像转换为附加在邮件消息上的临时二进制(图像)文件,并将正文<img src="data:image/png;base64,iVBORw0KGgoAAAAN...替换为<img src="cid:cid_image_id.jpg" />,成为电子邮件正文中的内联图像。
这里有一个例子:

procedure SendMail();
var
  LHtmlPart: TIdText;
  LMessage: TIdMessage;
  LImagePart: TIdAttachmentFile;
  LHtmlText: String;
  LAttachment: TIdAttachmentFile;    
  SMTP: TIdSMTP;
  SSL: TIdSSLIOHandlerSocketOpenSSL;
begin    
  LMessage:= TIdMessage.Create(nil);
  try
    // Message stuff //
    LMessage.From.Text := 'email@mail.com';
    LMessage.From.Name:= 'from name';
    LMessage.Recipients.Add.Address := 'email@mail.com';
    LMessage.Subject := 'subject';
    LMessage.ContentType := 'multipart/mixed';

    // Build HTML message //
    LHtmlPart:= TIdText.Create(LMessage.MessageParts);
    LHtmlPart.ContentType:= 'text/html';
    LHtmlText:= TFile.ReadAllText('filename.html');

    // base64 to temporary file and attach images to message //
    DecodeHtmlImages(LHtmlText, LMessage, LImagePart);
    LHtmlPart.Body.Text:= LHtmlText;
    
    // Attachs (not inline images) //
    LAttachment:= TIdAttachmentFile.Create(LMessage.MessageParts, 'filename1');
    LAttachment.FileName:= ExtractFileName('filename1');

    LAttachment:= TIdAttachmentFile.Create(LMessage.MessageParts, 'filename2');
    LAttachment.FileName:= ExtractFileName('filename2');

    SSL:= TIdSSLIOHandlerSocketOpenSSL.Create(nil);
    SSL.SSLOptions.Mode:= sslmClient;
    SSL.SSLOptions.Method:= sslvSSLv23;

    SMTP:= TIdSMTP.Create(nil);
    SMTP.IOHandler:= SSL;
    SMTP.Host:= 'smtp.office365.com';
    SMTP.Port:=  587;
    SMTP.AuthType := satDefault;
    // ms mail service //
    SMTP.UseTLS:= utUseExplicitTLS;
    SMTP.Username:= 'email@email.com';
    SMTP.Password:=  'password';

    try
      SMTP.Connect();
      SMTP.Send(LMessage);
    except
      ShowMessage('Failed: ' + E.Message);
    end;

  finally
    LHtmlPart.Free;
    LImagePart.Free;
    LMessage.Free;
    SMTP.Free;
    SSL.Free;
  end;

我在上面使用的附加函数:

procedure DecodeHtmlImages(var ABody: String; var AMessage: TIdMessage; var AImagePart: TIdAttachmentFile);
var
  LStream: TMemoryStream;
  LMatch: TMatch;
  LMatches: TMatchCollection;
  LBase64: String;
  LImageData: TBytes;
  LFilename: String;
const
  EXP_ENCODED_SOURCE = 'src\s*=\s*"([cid^].+?)"';
begin

  LMatches:= TRegEx.Matches(ABody, EXP_ENCODED_SOURCE, [roIgnoreCase]);
  for LMatch in LMatches do
  begin
    // step 1 - convert and save temp file //
    LBase64:= ExtractBase64FromHTML(LMatch.Value);
    Lstream := TBytesStream.Create(TNetEncoding.Base64.DecodeStringToBytes(LBase64));
    try
      LFilename:= IncludeTrailingPathDelimiter(System.IOUtils.TPath.GetTempPath) + 'tmp_' + FormatDateTime('yyyymmddhhnnsszzz', Now) + '.' + ExtractImageExtensionFromHTML(ABody);
      LStream.SaveToFile(LFilename);
    finally
      LStream.Free;
    end;

    // step 2 - replace base64 code for "cid" and attach all images //
    if FileExists(LFilename) then
    begin
      AImagePart:= TIdAttachmentFile.Create(AMessage.MessageParts, LFilename);
      try
        AImagePart.ContentType:= Format('image/%s', [StringReplace(TPath.GetExtension(LFilename), '.', '', [rfIgnoreCase])]);
        AImagePart.ContentDisposition:= 'inline';
        AImagePart.FileIsTempFile:= True;
        AImagePart.ExtraHeaders.Values['content-id']:= TPath.GetFileName(LFilename);
        AImagePart.DisplayName:= TPath.GetFileName(LFilename);

        ABody:= StringReplace(ABody, LMatch.Value, Format('src="cid:%s"', [TPath.GetFileName(LFilename)]), [rfIgnoreCase]);
      finally
        //freeAndNil(LImagePart);      // cant be freed yet //
      end;
    end;
  end;
end;

function ExtractBase64FromHTML(HTML: string): string;
var
  RegEx: TRegEx;
  Match: TMatch;
begin
  RegEx := TRegEx.Create('data:image\/[a-zA-Z]*;base64,([^"]+)', [roIgnoreCase]);
  Match := RegEx.Match(HTML);

  if Match.Success then
    Result := Match.Groups[1].Value
  else
    Result := '';
end;

function ExtractImageExtensionFromHTML(htmlContent: string): string;
var
  regex: TRegEx;
  match: TMatch;
begin
  regex := TRegEx.Create('data:image\/(.*?);base64');
  match := regex.Match(htmlContent);
  if match.Success then
    Result := match.Groups.Item[1].Value
  else
    Result := '';
end;

我做了这个测试和工作很好,它能够发送多个图像,是在html消息(需要在base64格式),在不久的将来,我会重构整个代码接口互动隔离和解耦的代码。

相关问题