Delphi - Indy idMessage和idSMTP实现邮件的发送

  unit uMain;

  interface

  uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, RzPanel, RzShellDialogs, IdMessage, IdBaseComponent,

  IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,

  RzButton, StdCtrls, RzEdit, RzBtnEdt, Mask, RzLabel;

  type

  TMainFrm = class(TForm)

  gbMsgSet: TRzGroupBox;

  gbSrvSet: TRzGroupBox;

  lbSubject: TRzLabel;

  lbRsd: TRzLabel;

  lbCc: TRzLabel;

  lbBCc: TRzLabel;

  lbAth: TRzLabel;

  lbBdy: TRzLabel;

  lbUserName: TRzLabel;

  lbHost: TRzLabel;

  lbPsd: TRzLabel;

  edtSub: TRzEdit;

  edtRsd: TRzEdit;

  edtCc: TRzEdit;

  edtBCc: TRzEdit;

  beAth: TRzButtonEdit;

  mmBdy: TRzMemo;

  btnSendMail: TRzBitBtn;

  edtUN: TRzEdit;

  edtHst: TRzEdit;

  edtPsd: TRzEdit;

  IdSMTP: TIdSMTP;

  IdMessage: TIdMessage;

  odMain: TRzOpenDialog;

  procedure beAthButtonClick(Sender: TObject);

  procedure btnSendMailClick(Sender: TObject);

  private

  { Private declarations }

  public

  { Public declarations }

  end;

  var

  MainFrm: TMainFrm;

  implementation

  {$R *.dfm}

  procedure TMainFrm.beAthButtonClick(Sender: TObject);

  begin

  with odMain do

  begin

  Execute;

  if FileName <> '' then

  begin

  beAth.Text := FileName;

  end;

  end;

  end;

  procedure TMainFrm.btnSendMailClick(Sender: TObject);

  begin

  try

  if (Trim(edtCc.Text) = '') and (Trim(edtRsd.Text) = '') and (Trim(edtBCc.Text) = '') then

  begin

  MessageDlg('You should input Rsd, please check,thanks!', mtInformation, [mbOK], 0);

  edtRsd.SetFocus;

  Exit;

  end;

  with IdMessage do

  begin

  Clear;

  Subject := edtSub.Text;

  From.Text := edtUN.Text;

  Recipients.EMailAddresses := edtRsd.Text;

  CCList.EMailAddresses := edtCC.Text;

  BccList.EMailAddresses := edtBCc.Text;

  Priority := TIdMessagePriority(4);

  if Trim(beAth.Text) <> '' then

  begin

  TIdAttachment.Create(MessageParts, Trim(beAth.Text));

  end;

  Body.Assign(mmBdy.Lines);

  end;

  except

  on E: Exception do

  begin

  MessageDlg('Msg Set Failed with Err information [' + E.Message + ']', mtWarning, [mbOK], 0);

  Exit;

  end;

  end;

  try

  if (Trim(edtUN.Text) = '') or (Trim(edtHst.Text) = '') or (Trim(edtPsd.Text) = '') then

  begin

  MessageDlg('You should input UN, please check,thanks!', mtInformation, [mbOK], 0);

  edtUN.SetFocus;

  Exit;

  end;

  with IdSMTP do

  begin

  if Connected then Disconnect;

  AuthenticationType := atLogin;

  Port := 25;

  UserName := edtUN.Text;

  Password := edtPsd.Text;

  Host := edtHst.Text;

  Connect;

  end;

  except

  on E: Exception do

  begin

  MessageDlg('Srv Set Failed with Err information [' + E.Message + ']', mtWarning, [mbOK], 0);

  Exit;

  end;

  end;

  try

  IdSMTP.Send(IdMessage);

  IdSMTP.Disconnect;

  MessageDlg('OK!', mtInformation, [mbOK], 0);

  except

  on E: Exception do

  begin

  MessageDlg('Send Failed with Err information [' + E.Message + ']', mtWarning, [mbOK], 0);

  Exit;

  end;

  end;

  end;

  end.