使用代码发送邮件[EMAIL]的功能

蔚蓝海岸

由于原来提供的代码和平台提供的邮件功能联系过于紧密，现在将如何发送邮件的代码单独提炼出来实现。
此代码实现了向公网发送邮件的功能，此功能需要引入“思维加速\邮件\邮件系统”功能

procedure TMainForm.Button2Click(Sender: TObject);
var
  SendMailExchang: TMessageExchanger;  //用于发送邮件的交换机
  lAccount: TMailAccount;
  MailSystem: TMailSystem;
  lMailContent: TMemoryStream;
  lMessage: TMessage;
begin
  MailSystem := TMailSystem.Create;
  SendMailExchang := TMessageExchanger.Create(nil);
  lMessage := TMessage.Create(nil);
  lAccount := TMailAccount.Create;
  try
    SendMailExchang.MessageKind := TMessageKind.mkSend;
    lMessage.From := 'xxx@sohu.com';  //发件人
    lMessage.SendTo := 'xxx@sohu.com';  //收件人
    lMessage.BCC := 'xxx@sohu.com';
    lMessage.CC := 'xxx@sohu.com';
    lMessage.Subject := '测试邮件';  //邮件标题
    lMessage.Body.Text := '这是一封测试邮件！邮件正文';   //正文
    lMessage.ContentFormatType := TContentFormatType.ftText;  // 设置正文内容格式
    lMessage.Date := business.System.SysUtils.DateToStr(business.System.SysUtils.now());
      //根据邮件的发件人获取发送邮件的帐号，
      //此帐号是从Business邮件系统中设置的帐号中获得的
      //如果使用自定义的发送帐户，请重新设置lAccount对象的相关属性
    lAccount := MailSystem.FindAccountByAddress(lMessage.From);
    if lAccount <> nil then
    begin
      lMailContent := TMemoryStream.Create;  //用于存放邮件的正文
      lMailContent.Clear;
      lMessage.SaveToStream(lMailContent);
      lMailContent.Position := 0;  //移动流的指针
      try
        if lAccount.Verify then
        begin
          if lAccount.DifferPOP then
            SendMailExchang.SMTPMessages.Add(lAccount.VerifyAccount,
              lAccount.VerifyPassword, lAccount.SMTPHost,
              lMessage.From, lMessage.SendTo, lMailContent, lAccount.SMTPPort)
          else
            SendMailExchang.SMTPMessages.Add(lAccount.UserID, lAccount.Password,
              lAccount.SMTPHost, lMessage.From, lMessage.SendTo, lMailContent,
              lAccount.SMTPPort);
        end
        else
          SendMailExchang.SMTPMessages.Add(lAccount.SMTPHost, lMessage.From,
            lMessage.SendTo, lMailContent, lAccount.SMTPPort);
      finally
        lMailContent.Free;
        lAccount.Free;
      end;
        SendMailExchang.Active := True;  //发送邮件
    end;
  finally
    lMessage.Free;
    MailSystem.Free;
    SendMailExchang.Free;  //  SendMailExchang对象一定要最后释放
  end;
end;

SMP

基本思路没有问题，就是这样做，但详细到代码写是是不是对只是看，看不出有什么问题来！试试吧！

atiger

1楼是外部邮件，内部邮件参考
uses
  MAILLIBRARY;

procedure TfrmSendMail.SendMail1;
var
  MailGUID, MailPath: string;
  lStream: TStream;
begin
  lStream := TMemoryStream.Create;
  MailGUID := jsCommon.CreateGUIDStr;
  MailPath := 'BIZ_DRAFT';
  try
    //生成邮件内容
    SaveToStream('ZS', edtRec.Text, '', '', edtSub.Text, memo1.Text, lStream);
    //保存邮件到发件箱
    SaveMail(mailGuid, mailPath, lStream);
    //发送内部邮件
    TMailSystem.CreateMailSystem.SendInternalMail(MailGuid, edtRec.Text, 0, 0);
    //移动发件箱信息到已发送邮箱
    TMailSystem.CreateMailSystem.MoveMail(MailGUID, 'BIZ_OUTBOX', 'BIZ_SENTBOX');
  finally
    lStream.Free;
  end;
end;

procedure TfrmSendMail.SaveToStream(Const AFrom, ASendTo, ACC, ABcc, ASubject,
  ABodyText: String; var AStream: TStream);
var
  msgMail: TMessage;
begin
  msgMail := TMessage.Create(self);
  try
    msgMail.From := AFrom;
    msgMail.SendTo := ASendTo;
    msgMail.CC := ACC;
    msgMail.Bcc := ABcc;
    msgMail.Subject := ASubject;
    msgMail.Body.Text := ABodyText;
    msgMail.SaveToStream(AStream);
  finally
    msgMail.Free;
  end;
end;

procedure TfrmSendMail.SaveMail(var MailGUID, MailPath: string; AStream: TStream);
var
  lMailRef: TMailReference;
  lContent: TStream;
  lAttachments: TObjectList;
  lMailGUID, lMailPath: string;
begin
  lMailGUID := MailGUID;
  //保存的路径
  lMailPath := 'BIZ_OUTBOX';

  lMailRef := TMailReference.Create;
  lMailRef.MailGUID := lMailGUID;
  lMailRef.MailInfo.MailGUID := lMailGUID;
  lMailRef.MailInfo.UIDL := jsCommon.CreateGUIDStr;
  lMailRef.PathGUID := lMailPath;

  lContent := TMemoryStream.Create;
  lAttachments := TObjectList.Create(True);

  AStream.Position := 0;
  TMailSystem.CreateMailSystem.MsgStreamToMail(lMailRef, lContent, lAttachments, AStream);

  lMailRef.MailInfo.Date := SysUtils.Now;
  lMailRef.Time := lMailRef.MailInfo.Date;
  lMailRef.State := 2;

  //保存邮件
  TMailSystem.CreateMailSystem.SaveMail(lMailRef, lContent, lAttachments);

  MailPath := lMailPath;
  MailGUID := lMailGUID;
end;