1
{*******************************************************************************************}2
{ }3
{ Title: 发送网页邮件 }4
{ Author: BusyAnt(http://hi.csdn.net/BusyAnt) }5
{ Date: 2009/05/27 }6
{ Description: }7
{ 1、网页邮件 }8
{ 2、多名收件人 }9
{ 3、正则表达式匹配EMial地址 }10
{ 4、TPerlRegEx类的使用 }11
{ 5、Mail文件结构 }12
{ }13
{*******************************************************************************************}14

15
unit ufrmMain;16

17
interface18

19
uses20
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,21
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,22
IdTCPClient, IdMessageClient, IdSMTP, IDMessage, IniFiles, Shellapi;23

24
type25
TfrmMain = class(TForm)26
Label1: TLabel;27
Label2: TLabel;28
btnSend: TButton;29
Edit1: TEdit;30
Edit2: TEdit;31
Button1: TButton;32
Button2: TButton;33
OpenDialog1: TOpenDialog;34
IdSMTP1: TIdSMTP;35
procedure Button1Click(Sender: TObject);36
procedure Button2Click(Sender: TObject);37
procedure SendMail();38
procedure btnSendClick(Sender: TObject);39
private 40
config: TIniFile;41
{ Private declarations }42
public43
{ Public declarations }44
end;45

46
var47
frmMain: TfrmMain;48

49
implementation50

51
uses PerlRegEx;52

53
{$R *.dfm}54

55
procedure TfrmMain.SendMail();56
var57
idmessage: TIdMessage;58

59
// 验证邮件地址60
function ValidateMailAddress(s: string): boolean;61
var62
reg: TPerlRegEx;63
begin64
reg := TPerlRegEx.Create(nil);65
reg.Subject := s;66
reg.RegEx := '\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b';67
reg.Options := [preCaseLess]; // 忽略大小写68
result := reg.Match;69
reg.Free;70
end;71

72
// 添加收件人73
procedure BuildAddresseeList();74
var 75
addresseelist: TStringList;76
i: Integer;77
j: Integer;78
begin79
addresseelist := TStringList.Create;80
addresseelist.LoadFromFile(self.Edit1.Text);81
j := 0;82
for i:=0 to addresseelist.Count-1 do83
begin84
if ValidateMailAddress(addresseelist.Strings[i]) then85
begin86
idmessage.Recipients.Add; // 增加收件人87
idmessage.Recipients.Items[j].Address := addresseelist.Strings[i]; // 容忍空格//StringReplace(addresseelist.Strings[i], ' ', '', [rfReplaceAll]);88
Inc(j);89
end90
else91
continue; 92
end;93
addresseelist.Free;94
end;95

96
// 生成邮件97
procedure BuildMessage();98
var99
htmlbody: TStringList;100
begin101
BuildAddresseeList;102
idmessage.From.Text := config.ReadString('Mail', 'From', '');103
idmessage.ContentType := 'text/html';104
idmessage.Subject := config.ReadString('Mail', 'Subject', 'Hello');105
htmlbody := TStringList.Create;106
htmlbody.LoadFromFile(self.Edit2.Text);107
idmessage.Body := htmlbody;108
htmlbody.Free;109
end;110

111
// 配置Smtp112
procedure BuildSmtp();113
begin114
idSMTP1.Host := config.ReadString('Mail', 'SmtpHost', '');115
idSMTP1.Port := StrToInt(config.ReadString('Mail', 'Port', '25'));116
idSMTP1.AuthenticationType := atLogin;117
idSMTP1.Username := config.ReadString('Mail', 'UserAccount', '');118
idSMTP1.Password := config.ReadString('Mail', 'Password', ''); 119
idmessage := TIdMessage.Create(idSMTP1);120
end;121
begin 122
try123
config := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'config.ini');124
BuildSmtp;125
BuildMessage;126
idSMTP1.Connect;127
if idSMTP1.Authenticate then128
begin129
idSMTP1.Send(idmessage);130
idSMTP1.Disconnect;131
end132
else133
raise Exception.Create('没有验证通过');134
except135
on E: Exception do MessageBox(self.Handle, PChar(E.Message), '出错', MB_ICONERROR);136
end;137
end;138

139
procedure TfrmMain.Button1Click(Sender: TObject);140
begin141
self.OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);142
self.OpenDialog1.Filter := '文本文件(*.txt)|*.txt|所有文件(*.*)|*.*';143
if(self.OpenDialog1.Execute) then144
self.Edit1.Text := self.OpenDialog1.FileName;145
end;146

147
procedure TfrmMain.Button2Click(Sender: TObject);148
begin149
self.OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);150
self.OpenDialog1.Filter := '网页文件(*.htm, *.html)|*.htm;*.html|所有文件(*.*)|*.*';151
if(self.OpenDialog1.Execute) then152
self.Edit2.Text := self.OpenDialog1.FileName;153
end;154

155
procedure TfrmMain.btnSendClick(Sender: TObject);156
begin157
self.SendMail();158
end;159

160
end.