Delphi - Indy TIdMessage和TIdSMTP实现邮件的发送

idMessage / idSMTP

首先对idMessage类的各种属性进行赋值（邮件的基本信息，如收件人、邮件主题、邮件正文等），其次通过idSMTP连接邮箱服务器，最后通过idSMTP的Send方法将idMessage发送出去。

界面布局如下： 

代码如下：

  1 unit uMain;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, ExtCtrls, RzPanel, RzShellDialogs, IdMessage, IdBaseComponent,
  8   IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  9   RzButton, StdCtrls, RzEdit, RzBtnEdt, Mask, RzLabel;
 10 
 11 type
 12   TMainFrm = class(TForm)
 13     gbMsgSet: TRzGroupBox;
 14     gbSrvSet: TRzGroupBox;
 15     lbSubject: TRzLabel;
 16     lbRsd: TRzLabel;
 17     lbCc: TRzLabel;
 18     lbBCc: TRzLabel;
 19     lbAth: TRzLabel;
 20     lbBdy: TRzLabel;
 21     lbUserName: TRzLabel;
 22     lbHost: TRzLabel;
 23     lbPsd: TRzLabel;
 24     edtSub: TRzEdit;
 25     edtRsd: TRzEdit;
 26     edtCc: TRzEdit;
 27     edtBCc: TRzEdit;
 28     beAth: TRzButtonEdit;
 29     mmBdy: TRzMemo;
 30     btnSendMail: TRzBitBtn;
 31     edtUN: TRzEdit;
 32     edtHst: TRzEdit;
 33     edtPsd: TRzEdit;
 34     IdSMTP: TIdSMTP;
 35     IdMessage: TIdMessage;
 36     odMain: TRzOpenDialog;
 37     procedure beAthButtonClick(Sender: TObject);
 38     procedure btnSendMailClick(Sender: TObject);
 39   private
 40     { Private declarations }
 41   public
 42     { Public declarations }
 43   end;
 44 
 45 var
 46   MainFrm: TMainFrm;
 47 
 48 implementation
 49 
 50 {$R *.dfm}
 51 
 52 procedure TMainFrm.beAthButtonClick(Sender: TObject);
 53 begin
 54   with odMain do
 55   begin
 56     Execute;
 57     if FileName <> '' then
 58     begin
 59       beAth.Text := FileName;
 60     end;
 61   end;
 62 end;
 63 
 64 procedure TMainFrm.btnSendMailClick(Sender: TObject);
 65 begin
 66   try
 67     if (Trim(edtCc.Text) = '') and (Trim(edtRsd.Text) = '') and (Trim(edtBCc.Text) = '') then
 68     begin
 69       MessageDlg('You should input Rsd, please check,thanks!', mtInformation, [mbOK], 0);
 70       edtRsd.SetFocus;
 71       Exit;
 72     end;
 73     with IdMessage do
 74     begin
 75       Clear;
 76       Subject := edtSub.Text;
 77       From.Text := edtUN.Text;
 78       Recipients.EMailAddresses := edtRsd.Text;
 79       CCList.EMailAddresses := edtCC.Text;
 80       BccList.EMailAddresses := edtBCc.Text;
 81       Priority := TIdMessagePriority(4);
 82       if Trim(beAth.Text) <> '' then
 83       begin
 84         TIdAttachment.Create(MessageParts, Trim(beAth.Text));
 85       end;
 86       Body.Assign(mmBdy.Lines);
 87     end;
 88   except
 89     on E: Exception do
 90     begin
 91       MessageDlg('Msg Set Failed with Err information [' + E.Message + ']', mtWarning, [mbOK], 0);
 92       Exit;
 93     end;
 94   end;
 95   try
 96     if (Trim(edtUN.Text) = '') or (Trim(edtHst.Text) = '') or (Trim(edtPsd.Text) = '') then
 97     begin
 98       MessageDlg('You should input UN, please check,thanks!', mtInformation, [mbOK], 0);
 99       edtUN.SetFocus;
100       Exit;
101     end;
102     with IdSMTP do
103     begin
104       if Connected then Disconnect;
105       AuthenticationType := atLogin;
106       Port := 25;
107       UserName := edtUN.Text;
108       Password := edtPsd.Text;
109       Host := edtHst.Text;
110       Connect;
111     end;
112   except
113     on E: Exception do
114     begin
115       MessageDlg('Srv Set Failed with Err information [' + E.Message + ']', mtWarning, [mbOK], 0);
116       Exit;
117     end;
118   end;
119 
120   try
121     IdSMTP.Send(IdMessage);
122     IdSMTP.Disconnect;
123     MessageDlg('OK!', mtInformation, [mbOK], 0);
124   except
125     on E: Exception do
126     begin
127       MessageDlg('Send Failed with Err information [' + E.Message + ']', mtWarning, [mbOK], 0);
128       Exit;
129     end;
130   end;
131 
132 end;
133 
134 end.

 

  作者：Jeremy.Wu
  出处：https://www.cnblogs.com/jeremywucnblog/
  本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。

posted @ 2019-08-29 08:54  Jeremy.Wu  阅读(1504)  评论(0)  编辑  收藏  举报