delphi发送网页邮件

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

unit ufrmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdMessageClient, IdSMTP, IDMessage, IniFiles, Shellapi;

type
TfrmMain = class(TForm)
Label1: TLabel;
Label2: TLabel;
btnSend: TButton;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
IdSMTP1: TIdSMTP;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SendMail();
procedure btnSendClick(Sender: TObject);
private
config: TIniFile;
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

uses PerlRegEx;

{$R *.dfm}

procedure TfrmMain.SendMail();
var
idmessage: TIdMessage;

// 验证邮件地址
function ValidateMailAddress(s: string): boolean;
var
reg: TPerlRegEx;
begin
reg := TPerlRegEx.Create(nil);
reg.Subject := s;
reg.RegEx := '/b[A-Z0-9._%+-]+@[A-Z0-9.-]+/.[A-Z]{2,4}/b';
reg.Options := [preCaseLess]; // 忽略大小写
result := reg.Match;
reg.Free;
end;

// 添加收件人
procedure BuildAddresseeList();
var
addresseelist: TStringList;
i: Integer;
j: Integer;
begin
addresseelist := TStringList.Create;
addresseelist.LoadFromFile(self.Edit1.Text);
j := 0;
for i:=0 to addresseelist.Count-1 do
begin
if ValidateMailAddress(addresseelist.Strings[i]) then
begin
idmessage.Recipients.Add;  // 增加收件人
idmessage.Recipients.Items[j].Address := addresseelist.Strings[i];  // 容忍空格//StringReplace(addresseelist.Strings[i], ' ', '', [rfReplaceAll]);
Inc(j);
end
else
continue;
end;
addresseelist.Free;
end;

// 生成邮件
procedure BuildMessage();
var
htmlbody: TStringList;
begin
BuildAddresseeList;
idmessage.From.Text := config.ReadString('Mail', 'From', '');
idmessage.ContentType := 'text/html';
idmessage.Subject := config.ReadString('Mail', 'Subject', 'Hello');
htmlbody := TStringList.Create;
htmlbody.LoadFromFile(self.Edit2.Text);
idmessage.Body := htmlbody;
htmlbody.Free;
end;

// 配置Smtp
procedure BuildSmtp();
begin
idSMTP1.Host := config.ReadString('Mail', 'SmtpHost', '');
idSMTP1.Port := StrToInt(config.ReadString('Mail', 'Port', '25'));
idSMTP1.AuthenticationType := atLogin;
idSMTP1.Username := config.ReadString('Mail', 'UserAccount', '');
idSMTP1.Password := config.ReadString('Mail', 'Password', '');
idmessage := TIdMessage.Create(idSMTP1);
end;
begin
try
config := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'config.ini');
BuildSmtp;
BuildMessage;
idSMTP1.Connect;
if idSMTP1.Authenticate then
begin
idSMTP1.Send(idmessage);
idSMTP1.Disconnect;
end
else
raise Exception.Create('没有验证通过');
except
on E: Exception do MessageBox(self.Handle, PChar(E.Message), '出错', MB_ICONERROR);
end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
self.OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
self.OpenDialog1.Filter := '文本文件(*.txt)|*.txt|所有文件(*.*)|*.*';
if(self.OpenDialog1.Execute) then
self.Edit1.Text := self.OpenDialog1.FileName;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
self.OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
self.OpenDialog1.Filter := '网页文件(*.htm, *.html)|*.htm;*.html|所有文件(*.*)|*.*';
if(self.OpenDialog1.Execute) then
self.Edit2.Text := self.OpenDialog1.FileName;
end;

procedure TfrmMain.btnSendClick(Sender: TObject);
begin
self.SendMail();
end;

end.