楼主，你按照我的下面代码去试试（我这边测试都是可以正常发送的）
函数声明
{发送邮件，传入参数说明：
lFrom 发件人
lSendTO 收件人
lBCC 密抄送人
lCC 抄送人
lSubject 邮件标题
lSMTP 邮件SMTP服务器
lPop3 邮件Pop3服务器
lSMTPPort 邮件SMTP服务器端口，默认25
lPop3Port 邮件Pop3服务器端口，默认110
lAccoundID 邮件名称，任意取
lMailAddress 邮件地址，发件人的地址
lUserID 邮件接收服务器帐户名，发件人的地址
lPassword 邮件接收服务器帐户密码
lVerify 邮件服务器是否要认证，默认需要认证
lVerifyAccount 认证名
lVerifyPassword 认证密码
lMemo 邮件正文
lFileName 邮件附件路径
}
static function SendWebMail(lFrom,lSendTO,lBCC,lCC,lSubject : String;
lSMTP,lPop3 : String; lSMTPPort,lPop3Port : Integer;
lAccoundID,lMailAddress,lUserID,lPassword : String; lVerify : Boolean;
lVerifyAccount,lVerifyPassword : String;
lMemo : TMemo;lFileName : String) : Boolean;
函数实现
static function TYJFS.SendWebMail(lFrom,lSendTO,lBCC,lCC,lSubject : String;
lSMTP,lPop3 : String; lSMTPPort,lPop3Port : Integer;
lAccoundID,lMailAddress,lUserID,lPassword : String; lVerify : Boolean;
lVerifyAccount,lVerifyPassword : String;
lMemo : TMemo;lFileName : String) : Boolean;
var
SendMailExchang: TMessageExchanger; //用于发送邮件的交换机
lAccount: TMailAccount;
MailSystem: TMailSystem;
lMailContent: TMemoryStream;
lMessage: TMessage;
lFrm : TZZFSYJ;//建立一个窗体用于发送邮件时的提示等待
begin
Result := False;
MailSystem := TMailSystem.Create;
SendMailExchang := TMessageExchanger.Create(nil);
lMessage := TMessage.Create(nil);
lAccount := TMailAccount.Create;
lFrm := TZZFSYJ.Create(nil);
try
lFrm.Show;
if Borland.Delphi.Windows.MessageBox(0,'确定开始发送邮件吗？','是否发邮件提示',Borland.Delphi.Windows.MB_YESNO) =Borland.Delphi.Windows.IDNO then
begin
lFrm.Free;
lMessage.Free;
MailSystem.Free;
SendMailExchang.Free; // SendMailExchang对象一定要最后释放
Exit;
end;
SendMailExchang.MessageKind := TMessageKind.mkSend;
lMessage.From := lFrom; //发件人
lMessage.SendTo := lSendTO; //收件人
//lMessage.BCC := lBCC;
lMessage.CC := lCC;
lMessage.Subject := lSubject; //邮件标题
lMessage.Body.Text := Trim(lMemo.Text); //正文
lMessage.ContentFormatType := TContentFormatType.ftText; // 设置正文内容格式
lMessage.Date := business.System.SysUtils.DateToStr(Business.System.SysUtils.Time);
//根据邮件的发件人获取发送邮件的帐号，
//此帐号是从Business邮件系统中设置的帐号中获得的
//如果使用自定义的发送帐户，请重新设置lAccount对象的相关属性
//lAccount := MailSystem.FindAccountByAddress(lMessage.From);
lAccount.SMTPHost := lSMTP;
lAccount.SMTPPort := lSMTPPort;
lAccount.POPHost := lPop3;
lAccount.POPPort := lPop3Port;
lAccount.AccountID := lAccoundID;
lAccount.MailAddress := lMailAddress;
lAccount.UserID := lUserID;
lAccount.Password := lPassword;
lAccount.Verify := lVerify;
lAccount.VerifyAccount := lVerifyAccount;
lAccount.VerifyPassword := lVerifyPassword;
if FileExists(lFileName) then
lMessage.AddAttachment(lFileName);
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+#13#10+lMessage.CC, lMailContent, lAccount.SMTPPort,false)
else
SendMailExchang.SMTPMessages.Add(lAccount.UserID, lAccount.Password,
lAccount.SMTPHost, lMessage.From, lMessage.SendTo+#13#10+lMessage.CC, lMailContent,
lAccount.SMTPPort,false);
end
else
SendMailExchang.SMTPMessages.Add(lAccount.SMTPHost, lMessage.From,
lMessage.SendTo+#13#10+lMessage.CC, lMailContent, lAccount.SMTPPort,false);
finally
lMailContent.Free;
lAccount.Free;
end;
SendMailExchang.Active := True; //发送邮件
Sleep(3000);
end;
Result := True;
except
Result := False;
end;
lFrm.Free;
lMessage.Free;
MailSystem.Free;
SendMailExchang.Free; // SendMailExchang对象一定要最后释放
end; |
发表于 2010-8-4 15:32:36
楼主