delphi 发送邮件

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.