Delphi使用Indy組件實現郵件群發例子代碼+注釋

Delphi編寫實現的郵件群發程序代碼，主要是使用Indy組件來實現，發送郵件使用SMTP協議，使用TidMessage組件配合TIdSMTP組件來完成，本郵件群發程序運行界面圖：

完整的Delphi郵件群發代碼：

vIEw source print? 001 unit Unit1; 002 interface 003 uses 004   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 005   Dialogs, StdCtrls, ExtCtrls, IdMessage, IDBaseComponent, IdComponent, 006   IdTCPConnection, IdTCPClient, IdMessageClIEnt, IdSMTP, ComCtrls, Menus, IniFiles; 007 type 008   TForm1 = class(TForm) 009     IdSMTP1: TIdSMTP; 010     IdMessage1: TIdMessage; 011     ListBox1: TListBox; 012     le_title: TLabeledEdit; 013     me_content: TMemo; 014     Label1: TLabel; 015     GroupBox1: TGroupBox; 016     GroupBox2: TGroupBox; 017     le_smtp: TLabeledEdit; 018     le_user: TLabeledEdit; 019     le_email: TLabeledEdit; 020     le_port: TLabeledEdit; 021     Button1: TButton; 022     Button2: TButton; 023     Button3: TButton; 024     Button4: TButton; 025     Button5: TButton; 026     OpenDialog1: TOpenDialog; 027     SaveDialog1: TSaveDialog; 028     StatusBar1: TStatusBar; 029     Button6: TButton; 030     PopupMenu1: TPopupMenu; 031     N1: TMenuItem; 032     N2: TMenuItem; 033     N3: TMenuItem; 034     N4: TMenuItem; 035     le_pass: TLabeledEdit; 036     cb_authentication: TCheckBox; 037     procedure Button1Click(Sender: TObject); 038     procedure Button2Click(Sender: TObject); 039     procedure Button5Click(Sender: TObject); 040     procedure FormShow(Sender: TObject); 041     procedure Button6Click(Sender: TObject); 042     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 043     procedure N1Click(Sender: TObject); 044     procedure N2Click(Sender: TObject); 045     procedure N3Click(Sender: TObject); 046     procedure Button3Click(Sender: TObject); 047     procedure Button4Click(Sender: TObject); 048   private 049     function SendEmail(aAddr: string): boolean; 050     { Private declarations } 051   public 052     { Public declarations } 053   end; 054 var 055   Form1: TForm1; 056 implementation 057 {$R *.dfm} 058 procedure TForm1.Button1Click(Sender: TObject); 059 begin 060   if not OpenDialog1.Execute then Exit; //如果沒有選擇文件則退出 061   ListBox1.Items.LoadFromFile(OpenDialog1.FileName); 062 end; 063 procedure TForm1.Button2Click(Sender: TObject); 064 begin 065   if ListBox1.Items.Count = 0 then exit; 066   if SaveDialog1.Execute then //選擇了保存文件 067     ListBox1.Items.SaveToFile(SaveDialog1.FileName); 068 end; 069 procedure TForm1.Button5Click(Sender: TObject); 070 begin //保存配置 071   with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'comm.ini') do 072   begin 073     WriteString('comm', 'smtp', le_smtp.Text); 074     WriteString('comm', 'port', le_port.Text); 075     WriteString('comm', 'user', le_user.Text); 076     WriteString('comm', 'pass', le_pass.Text); 077     WriteString('comm', 'email', le_email.Text); 078     WriteBool('comm', 'pass', cb_authentication.Checked); 079   end; 080 end; 081 procedure TForm1.FormShow(Sender: TObject); 082 begin //讀取配置 083   with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'comm.ini') do 084   begin 085     le_smtp.Text := ReadString('comm', 'smtp', 'smtp.163.com'); 086     le_port.Text := ReadString('comm', 'port', '25'); 087     le_user.Text := ReadString('comm', 'user', ''); 088     le_pass.Text := ReadString('comm', 'pass', ''); 089     le_email.Text := ReadString('comm', 'email', ''); 090     cb_authentication.Checked := ReadBool('comm', 'pass', False); 091   end; 092 end; 093 procedure TForm1.Button6Click(Sender: TObject); 094 begin 095   Close; 096 end; 097 procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 098 begin 099   if Tag = 0 then 100     CanClose := True else 101   begin //正在發送狀態不能退出程序 102     CanClose := False; 103     ShowMessage('請先中斷發送'); 104   end; 105 end; 106 procedure TForm1.N1Click(Sender: TObject); 107 var 108   s: string; 109 begin 110   s := InputBox('輸入對話框', '請輸入郵件地址：', '@'); 111   if (Length(s) > 5) and (Pos('@', s) < Pos('.', s)) then 112     ListBox1.Items.Add(s); 113 end; 114 procedure TForm1.N2Click(Sender: TObject); 115 begin 116   ListBox1.DeleteSelected; 117 end; 118 procedure TForm1.N3Click(Sender: TObject); 119 begin 120   ListBox1.Clear; 121 end; 122 procedure TForm1.Button4Click(Sender: TObject); 123 begin 124   Tag := 0; //用Form1的Tag屬性作為發送中斷的標志可以省一個全局變量 125 end; 126 function TForm1.SendEmail(aAddr: string): boolean; 127 begin 128   IdMessage1.Body.Assign(me_content.Lines); 129   IdMessage1.From.Text := le_email.Text; 130   IdMessage1.ReplyTo.EMailAddresses := le_email.Text; 131   IdMessage1.RecipIEnts.EMailAddresses := aAddr; 132   IdMessage1.Subject := le_title.Text; 133 end; 134 procedure TForm1.Button3Click(Sender: TObject); 135 var 136   i: integer; 137 begin 138   if ListBox1.Items.Count = 0 then 139   begin 140     showmessage('發送列表為空，群發失敗！'); 141     exit; 142   end; 143   if me_content.Text = '' then 144   begin 145     showmessage('輸入郵件內容！'); 146     exit; 147   end; 148   Button3.Enabled := False; 149   if cb_authentication.Checked then //服務器驗證 150   begin 151     IdSMTP1.AuthenticationType := atLogin; 152     IdSMTP1.Username := le_user.Text; 153     IdSMTP1.PassWord := le_pass.Text; 154   end else 155   begin 156     IdSMTP1.AuthenticationType := atNone; 157   end; 158   IdSMTP1.Host := le_smtp.Text; 159   IdSMTP1.Port := StrToIntDef(le_port.Text, 25); //如果轉換錯誤默認25 160   IdSMTP1.Connect; //連接 161   try 162     Tag := 1; //設置中斷標志 163     for i := 0 to ListBox1.Items.Count - 1 do 164     begin //循環發送 165       if Tag = 0 then exit; //如果中斷則退出群發 166       SendEmail(ListBox1.Items.Strings[i]); 167       IdSMTP1.Send(IdMessage1); 168       ListBox1.ItemIndex := i; 169       StatusBar1.SimpleText := Format('正在發送... (%d/%d) %s', [i, ListBox1.Items.Count - 1, ListBox1.Items.Strings[i]]); 170       Application.ProcessMessages; 171     end; 172   finally 173     Tag := 0; 174     IdSMTP1.Disconnect; 175     Button3.Enabled := True; 176   end; 177   StatusBar1.SimpleText := '發送完成...'; 178 end; 179 end.