用delphi发送网页邮件

  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
 15unit ufrmMain;
 16
 17interface
 18
 19uses
 20  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 21  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
 22  IdTCPClient, IdMessageClient, IdSMTP, IDMessage, IniFiles, Shellapi;
 23
 24type
 25  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  public
 43    { Public declarations }
 44  end;
 45
 46var
 47  frmMain: TfrmMain;
 48
 49implementation
 50
 51uses PerlRegEx;
 52
 53{$R *.dfm}
 54
 55procedure TfrmMain.SendMail();
 56var
 57  idmessage: TIdMessage;
 58
 59  // 验证邮件地址
 60  function ValidateMailAddress(s: string): boolean;
 61  var
 62    reg: TPerlRegEx;
 63  begin
 64    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  begin
 79    addresseelist := TStringList.Create;
 80    addresseelist.LoadFromFile(self.Edit1.Text);
 81    j := 0;
 82    for i:=0 to addresseelist.Count-1 do
 83    begin
 84      if ValidateMailAddress(addresseelist.Strings[i]) then
 85      begin
 86        idmessage.Recipients.Add;  // 增加收件人
 87        idmessage.Recipients.Items[j].Address := addresseelist.Strings[i];  // 容忍空格//StringReplace(addresseelist.Strings[i], ' ', '', [rfReplaceAll]);
 88        Inc(j);
 89      end
 90      else
 91        continue;                       
 92    end;
 93    addresseelist.Free;
 94  end;
 95
 96  // 生成邮件
 97  procedure BuildMessage();
 98  var
 99    htmlbody: TStringList;
100  begin
101    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  // 配置Smtp
112  procedure BuildSmtp();
113  begin
114    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;
121begin  
122  try
123    config := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'config.ini');
124    BuildSmtp;
125    BuildMessage;
126    idSMTP1.Connect;
127    if idSMTP1.Authenticate then
128    begin
129      idSMTP1.Send(idmessage);
130      idSMTP1.Disconnect;
131    end
132    else
133      raise Exception.Create('没有验证通过');
134  except
135    on E: Exception do MessageBox(self.Handle, PChar(E.Message), '出错', MB_ICONERROR);
136  end;
137end;
138
139procedure TfrmMain.Button1Click(Sender: TObject);
140begin
141  self.OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
142  self.OpenDialog1.Filter := '文本文件(*.txt)|*.txt|所有文件(*.*)|*.*';
143  if(self.OpenDialog1.Execute) then
144    self.Edit1.Text := self.OpenDialog1.FileName;
145end;
146
147procedure TfrmMain.Button2Click(Sender: TObject);
148begin
149  self.OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
150  self.OpenDialog1.Filter := '网页文件(*.htm, *.html)|*.htm;*.html|所有文件(*.*)|*.*';
151  if(self.OpenDialog1.Execute) then
152    self.Edit2.Text := self.OpenDialog1.FileName;
153end;
154
155procedure TfrmMain.btnSendClick(Sender: TObject);
156begin
157  self.SendMail();
158end;
159
160end.