TIdSMTP 和 TIdAttachmentMemory - 垃圾邮件过滤器拒绝电子邮件

Question

我正在尝试使用 TIdSMTP 发送一封带有 PDF 附件的电子邮件，该附件存储在 BLOB 字段中。为此，我使用的是 TIdAttachmentMemory，但显示的代码导致“被垃圾邮件过滤器拒绝”；

1. 省略 IdMessage.ContentType := 'multipart/mixed' 有效，但附件未发送（或接收？） - 符合预期。
2. 保留此语句并从文件中创建附件（如注释代码中所示）一切正常（即正确接收带有附件的邮件）。

显然我错过了一些东西。我怀疑附件方向的某些内容没有正确“关闭”（即处于不完整状态）或者可能是不正确的 ContentType？

欢迎所有建议。谢谢！

procedure TfrmSendMail.btnSendClick(Sender: TObject);
var
  ms: TMemoryStream;
  Attachment: TIdAttachmentMemory;
  // Attachment: TIdAttachmentFile;
begin
  memStatus.Clear;

  IdSSLIOHandlerSocketOpenSSL.Destination := teHost.Text + ':587';
  IdSSLIOHandlerSocketOpenSSL.Host := teHost.Text;
  // IdSSLIOHandlerSocketOpenSSL.MaxLineAction := maException;
  IdSSLIOHandlerSocketOpenSSL.Port := 587;
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.Method := sslvTLSv1_2;
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmUnassigned;
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyMode := [];
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyDepth := 0;

  IdSMTP.Host := teHost.Text;
  IdSMTP.Port := 587;

  IdMessage.From.Address := teFrom.Text;
  IdMessage.Recipients.EMailAddresses := teTo.Text;
  IdMessage.Subject := teSubject.Text;
  IdMessage.Body.Text := memBody.Text;
  IdMessage.Body.Add('Timestamp: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss', Now()));

  IdMessage.ContentType := 'multipart/mixed';

  if not sqlPDFPDF_Incasso.IsNull then
  begin
    ms := TMemoryStream.Create;
    try
      try
        TBlobField(sqlPDF.FieldByName('PDF_Incasso')).SaveToStream(ms);
        ms.Position := 0;
        Attachment := TIdAttachmentMemory.Create(IdMessage.MessageParts, ms);
        Attachment.ContentType := 'application/pdf';
        Attachment.FileName := 'Invoice.pdf';
      except
        on E: Exception do
          messageDlg('Error creating attachment' + #13#10 + E.Message, mtError, [mbOK], 0);
      end;
    finally
      ms.Free;
    end;
  end;

  // if FileExists(beAttachment.Text) then
  // Attachment := TIdAttachmentFile.Create(IdMessage.MessageParts, beAttachment.Text);

  Screen.Cursor := crHourGlass;
  try
    try
      IdSMTP.Connect;
      IdSMTP.Send(IdMessage);
      memStatus.Lines.Insert(0, 'Email sent - OK.');
    except
      on E: Exception do
        memStatus.Lines.Insert(0, 'ERROR: ' + E.Message);
    end;
  finally
    if assigned(Attachment) then
      Attachment.Free;
    if IdSMTP.Connected then
      IdSMTP.Disconnect(true);
    Screen.Cursor := crDefault;
  end;
end;

Answer 1

您没有正确填充TIdMessage（有关详细信息，请参阅this blog article - 您的用例将属于“HTML 和非相关附件且没有纯文本”部分，但用纯文本替换 HTML )。

简而言之，如果您包含附件，将TIdMessage.ContentType 设置为'multipart/mixed' 是可以的，但您需要将正文放入TIdMessage.MessageParts 中的TIdText 对象中，而不是@987654329 中@。如果不包含附件，使用TIdMessage.Body 也可以，但您需要将TIdMessage.ContentType 设置为'text/plain'。

试试这个：

procedure TfrmSendMail.btnSendClick(Sender: TObject);
var
  Text: TIdText;
  Attachment: TIdAttachmentMemory;
  Strm: TStream;
begin
  memStatus.Clear;

  IdSSLIOHandlerSocketOpenSSL.SSLOptions.Method := sslvTLSv1_2;
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmClient;
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyMode := [];
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyDepth := 0;

  IdSMTP.Host := teHost.Text;
  IdSMTP.Port := 587;

  try
    IdMessage.Clear;

    IdMessage.From.Address := teFrom.Text;
    IdMessage.Recipients.EMailAddresses := teTo.Text;
    IdMessage.Subject := teSubject.Text;

    //if FileExists(beAttachment.Text) then
    if not sqlPDFPDF_Incasso.IsNull then
    begin
      IdMessage.ContentType := 'multipart/mixed';

      Text := TIdText.Create(IdMessage.MessageParts, nil);
      Text.Body.Text := memBody.Text;
      Text.Body.Add('Timestamp: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss', Now()));
      Text.ContextType := 'text/plain';

      //Attachment := TIdAttachmentFile.Create(IdMessage.MessageParts, beAttachment.Text);
      Attachment := TIdAttachmentMemory.Create(IdMessage.MessageParts);
      Attachment.ContentType := 'application/pdf';
      Attachment.FileName := 'Invoice.pdf';
      Strm := Attachment.PrepareTempStream;
      try
        TBlobField(sqlPDFPDF_Incasso).SaveToStream(Strm);
      finally
        Attachment.FinishTempStream;
      end;
    end else
    begin
      IdMessage.ContentType := 'text/plain';

      IdMessage.Body.Text := memBody.Text;
      IdMessage.Body.Add('Timestamp: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss', Now()));
    end;

    Screen.Cursor := crHourGlass;
    try
      IdSMTP.Connect;
      try
        IdSMTP.Send(IdMessage);
      finally
        IdSMTP.Disconnect;
      end;
      memStatus.Lines.Insert(0, 'Email sent - OK.');
    finally
      Screen.Cursor := crDefault;
    end;
  except
    on E: Exception do
      memStatus.Lines.Insert(0, 'ERROR: ' + E.Message);
  end;
end;

另外，Indy 有一个 TIdMessageBuilderPlain 类，可以为您正确设置 TIdMessage（有关详细信息，请参阅 this blog article - 您的用例将属于“纯文本和 HTML 和附件：不相关仅附件”部分）：

uses
  ..., IdMessageBuilder;

procedure TfrmSendMail.btnSendClick(Sender: TObject);
var
  Strm: TStream;
  Bldr: TIdMessageBuilderPlain;
begin
  memStatus.Clear;

  IdSSLIOHandlerSocketOpenSSL.SSLOptions.Method := sslvTLSv1_2;
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmClient;
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyMode := [];
  IdSSLIOHandlerSocketOpenSSL.SSLOptions.VerifyDepth := 0;

  IdSMTP.Host := teHost.Text;
  IdSMTP.Port := 587;

  try
    IdMessage.Clear;

    IdMessage.From.Address := teFrom.Text;
    IdMessage.Recipients.EMailAddresses := teTo.Text;
    IdMessage.Subject := teSubject.Text;

    Strm := nil;
    try
      Bldr := TIdMessageBuilderPlain.Create;
      try
        Bldr.PlainText.Text := memBody.Text;
        Bldr.PlainText.Add('Timestamp: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss', Now()));

        //if FileExists(beAttachment.Text) then
        if not sqlPDFPDF_Incasso.IsNull then
        begin
          //Bldr.Attachments.Add(beAttachment.Text);
          Strm := sqlPDFPDF_Incasso.DataSet.CreateBlobStream(sqlPDFPDF_Incasso, bmRead);
          Bldr.Attachments.Add(Strm, 'application/pdf').WantedFileName := 'Invoice.pdf';
        end;

        Bldr.FillMessage(IdMessage);
      finally
        Bldr.Free;
      end;
    finally
      Strm.Free;
    end;

    Screen.Cursor := crHourGlass;
    try
      IdSMTP.Connect;
      try
        IdSMTP.Send(IdMessage);
      finally
        IdSMTP.Disconnect;
      end;
      memStatus.Lines.Insert(0, 'Email sent - OK.');
    finally
      Screen.Cursor := crDefault;
    end;
  except
    on E: Exception do
      memStatus.Lines.Insert(0, 'ERROR: ' + E.Message);
  end;
end;