unit U_SendEmail;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
IdMessage, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP, xmldom, XMLIntf, msxmldom, XMLDoc, U_Config,
Dialogs;
type
TSendEmail=Class(TObject)
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
private
public
procedure SendEmail(ReceiverPath,CopyToPath,AttachmentPath:TStringList;
FSubject,FBody,DID:String);
end;
var
FHost,FFrom,FFromName,Port,Mailer,SMTPAuth,WordWrap,Username,Password,ContentType,ReplyTo:string;
XMLDocument1 : IXMLDocument;
implementation
uses U_Connect;
procedure TSendEmail.SendEmail(ReceiverPath, CopyToPath,
AttachmentPath: TStringList; FSubject, FBody, DID: String);
var i:integer;
FFileName,ConfFilePath,AppPath:string;
PostParams : TStringList;
nodexml,RValue: IXMLNode;
begin
if ReceiverPath.Count=0 then
begin
showmessage('请选择收件人!');
exit;
end ;
AppPath:=ExtractFilePath(Application.ExeName);
ConfFilePath := AppPath+'ini\SendEmailConfigure.xml' ;
if FileExists(ConfFilePath) then
begin
XMLDocument1 := TXMLDocument.Create(nil);
try
XMLDocument1.LoadFromFile(ConfFilePath);
XMLDocument1.Encoding := 'UTF-8' ;
XMLDocument1.Active := true;
nodexml := XMLDocument1.DocumentElement.ChildNodes['mail'].ChildNodes['service'];
FHost := nodexml.ChildNodes['Host'].NodeValue;
FFrom := nodexml.ChildNodes['From'].NodeValue;
FFromName := nodexml.ChildNodes['FromName'].NodeValue;
Port := nodexml.ChildNodes['Port'].NodeValue;
Mailer := nodexml.ChildNodes['Mailer'].NodeValue;
SMTPAuth := nodexml.ChildNodes['SMTPAuth'].NodeValue;
WordWrap := nodexml.ChildNodes['WordWrap'].NodeValue;
Username := nodexml.ChildNodes['Username'].NodeValue;
Password := nodexml.ChildNodes['Password'].NodeValue;
ContentType := nodexml.ChildNodes['ContentType'].NodeValue;
ReplyTo := nodexml.ChildNodes['ReplyTo'].NodeValue;
finally
XMLDocument1 := nil;
//DocIntf := nil;
end;
end
else
begin
showmessage('缺少邮件服务器配置文件!');
exit;
end;
IdSMTP1:=TIdSMTP.Create(nil);
IdMessage1:=TIdMessage.Create(nil);
IdSMTP1.Host:=FHost;
IdSMTP1.Port:=strtoint(Port);
IdSMTP1.Username:=Username;
IdSMTP1.Password:=Password;
IdMessage1.From.Address:=FFrom; //发件人地址
IdMessage1.From.Name := FFromName;
IdMessage1.ContentType := ContentType;
IdMessage1.Subject:=FSubject; //主题
IdMessage1.Body.Text:=FBody; //内容
// IdMessage1.ReplyTo.Add.Text := ReplyTo;
try
try
IdSMTP1.Connect;
if IdSMTP1.AuthSchemesSupported.IndexOf('LOGIN')>-1 then
begin
IdSMTP1.AuthenticationType := atLogin;
IdSMTP1.Authenticate;
end;
//收件人地址列表
for i:=0 to ReceiverPath.Count-1 do
begin
IdMessage1.Recipients.Add.Text := ReceiverPath.Strings[i];
end;
//抄送地址列表
if CopyToPath.Count<>0 then
begin
for i:=0 to CopyToPath.Count-1 do
begin
//IdMessage1.BccList.Add.Text:=CopyToPath.Strings[i]; //暗送地址
IdMessage1.CCList.Add.Text := CopyToPath.Strings[i]; //抄送地址;
end;
end;
//附件
if AttachmentPath.Count=0 then FFileName:=''
else
begin
for i:=0 to AttachmentPath.Count-1 do
begin
FFileName := AttachmentPath.Strings[i];
if trim(FFileName)<>'' then
TIdAttachment.Create(IdMessage1.MessageParts,FFileName);
end;
end;
IdSMTP1.Send(IdMessage1);
Application.ProcessMessages;
showmessage('邮件发送成功!');
except
on E:Exception do
raise Exception.Create('程序在试图发送邮件时出现错误!'+#13+'出错原因:'+e.Message);
end;
finally
if IdSMTP1.Connected then
IdSMTP1.Disconnect;
end;
//--------------添加到历史记录----------------------
for i:=0 to ReceiverPath.Count-1 do
begin
PostParams:=TStringList.Create;
PostParams.Add('adminjob=delivery');
PostParams.Add('kind=history');
PostParams.Add('DID='+DID);
PostParams.Add('Msg='+'发送邮件至:'+ReceiverPath.Strings[i]);
RValue := FConnect.Post(PostParams);
end;
end;
end.