cmailsender.pas

delphi深度探索第二版随书光盘所附内容

unit CMailSender;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, IndyMail_TLB, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient,
  IdMessageClient, IdSMTP, IdMessage, StdVcl, SysUtils;

type
  TMailSender = class(TAutoObject, IMailSender)
  private
    FSend: TIdSMTP;
    FEmail: TIdMessage;
  protected
    procedure SetBody(const Body: WideString); safecall;
    procedure SetSubject(const Subject: WideString); safecall;
    procedure SetFrom(const From: WideString); safecall;
    procedure SetTo(const To_: WideString); safecall;
    procedure SetHost(const Host: WideString); safecall;
    procedure SetSenderName(const SenderName: WideString); safecall;
    procedure SetSenderPW(const Password: WideString); safecall;
    procedure SetAuth(Auth: WordBool); safecall;
    function Send: WordBool; safecall;
  public
    destructor Destroy; override;
    procedure Initialize; override;
  end;

implementation

uses ComServ;

procedure TMailSender.SetBody(const Body: WideString);
begin
  FEmail.Body.Text := Body;
end;

procedure TMailSender.SetSubject(const Subject: WideString);
begin
  FEmail.Subject := Subject;
end;

procedure TMailSender.SetFrom(const From: WideString);
begin
  FEmail.From.Text := From;
  FEmail.ReplyTo.Clear;
  FEmail.ReplyTo.Add.Text := From;
end;

procedure TMailSender.SetTo(const To_: WideString);
begin
  FEmail.Recipients.Clear;
  FEmail.Recipients.Add.Text := To_;
end;

procedure TMailSender.SetHost(const Host: WideString);
begin
  FSend.Host := Host;
end;

procedure TMailSender.SetSenderName(const SenderName: WideString);
begin
  FSend.Username := SenderName;
end;

procedure TMailSender.SetSenderPW(const Password: WideString);
begin
  FSend.Password := Password;
end;

procedure TMailSender.SetAuth(Auth: WordBool);
begin
  if Auth then
    FSend.AuthenticationType := atLogin
  else
    FSend.AuthenticationType := atNone;
end;

destructor TMailSender.Destroy;
begin
  FEmail.Free;
  FSend.Free;
  inherited;
end;

procedure TMailSender.Initialize;
begin
  inherited;
  FSend := TIdSmtp.Create(nil);
  FEmail := TIdMessage.Create(nil);
end;

function TMailSender.Send: WordBool;
begin
  try
    try
      FSend.Connect();
      FSend.Send(FEmail);
      Result := True;
    except on E: Exception do
      begin
        Result := false;
      end;
    end;
  finally
    if FSend.Connected then
      FSend.Disconnect;
  end;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TMailSender, Class_MailSender,
    ciMultiInstance, tmApartment);
end.