一个群发邮件的DELPHI代码

s unit USMTP;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Buttons, StdCtrls, Psock, NMsmtp, Db, DBTables, ExtCtrls,
Grids, DBGrids, DBClient, Provider, DBCtrls;
type
TFSMTP = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
NMSMTP1: TNMSMTP;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
EditHost: TEdit;
EditPort: TEdit;
EditUserID: TEdit;
ButtonConnect: TSpeedButton;
DBGrid1: TDBGrid;
Label7: TLabel;
Label8: TLabel;
ButtonAdd: TSpeedButton;
ButtonRemove: TSpeedButton;
ButtonSend: TSpeedButton;
ListBoxAttachments: TListBox;
Label9: TLabel;
Label10: TLabel;
Panel1: TPanel;
Query1: TQuery;
Label11: TLabel;
Label12: TLabel;
EditSubject: TEdit;
OpenDialog1: TOpenDialog;
StatusBar1: TStatusBar;
MemoMail: TMemo;
EditTo: TEdit;
EditCC: TEdit;
EditBCC: TEdit;
ButtonDisconnect: TSpeedButton;
Label13: TLabel;
Label14: TLabel;
EditName: TEdit;
EditAddress: TEdit;
Label15: TLabel;
Label16: TLabel;
ButtonConnection2: TSpeedButton;
Button1: TButton;
Edit1: TEdit;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Edit2: TEdit;
DBLookupComboBox1: TDBLookupComboBox;
DataSource1: TDataSource;
Query1BDEDesigner: TIntegerField;
Query1BDEDesigner3: TStringField;
Query1BDEDesigner4: TStringField;
Query1BDEDesigner5: TStringField;
Query1BDEDesigner6: TFloatField;
Query1BDEDesigner7: TStringField;
Query1BDEDesigner8: TStringField;
Query1BDEDesigner9: TStringField;
Query1BDEDesigner10: TStringField;
Query1BDEDesigner11: TStringField;
Query1BDEDesigner12: TStringField;
Button2: TSpeedButton;
Panel2: TPanel;
Image1: TImage;
QDepartKind: TQuery;
DSDepartKind: TDataSource;
Query1BDEDesigner2: TStringField;
QDepartKindBDEDesigner: TStringField;
QDepartKindID: TIntegerField;
Memo1: TMemo;
procedure ButtonConnectClick(Sender: TObject);
procedure ButtonDisconnectClick(Sender: TObject);
procedure NMSMTP1Connect(Sender: TObject);
procedure NMSMTP1Disconnect(Sender: TObject);
procedure ButtonAddClick(Sender: TObject);
procedure ButtonRemoveClick(Sender: TObject);
procedure ButtonSendClick(Sender: TObject);
procedure NMSMTP1EncodeStart(Filename: String);
procedure NMSMTP1EncodeEnd(Filename: String);
procedure NMSMTP1ConnectionFailed(Sender: TObject);
procedure NMSMTP1ConnectionRequired(var Handled: Boolean);
procedure NMSMTP1Failure(Sender: TObject);
procedure NMSMTP1HostResolved(Sender: TComponent);
procedure NMSMTP1InvalidHost(var Handled: Boolean);
procedure NMSMTP1PacketSent(Sender: TObject);
procedure NMSMTP1RecipientNotFound(Recipient: String);
procedure NMSMTP1SendStart(Sender: TObject);
procedure NMSMTP1Success(Sender: TObject);
procedure NMSMTP1HeaderIncomplete(var handled: Boolean;
hiType: Integer);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ButtonConnection2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure DBLookupComboBox1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FSMTP: TFSMTP;
implementation
uses DataModoule,UnitSending,p_fandp;
{$R *.DFM}
procedure TFSMTP.ButtonConnectClick(Sender: TObject);
begin
NMSMTP1.Host:=EditHost.Text;
NMSMTP1.Port:=StrToInt(EditPort.Text);
NMSMTP1.UserId:=EditUserId.Text;
NMSMTP1.Connect;
ButtonConnect.Enabled:=False;
ButtonDisConnect.Enabled:=True;
end;
procedure TFSMTP.ButtonDisconnectClick(Sender: TObject);
begin
NMSMTP1.Disconnect;
ButtonConnect.Enabled:=True;
ButtonDisConnect.Enabled:=False;
end;
procedure TFSMTP.NMSMTP1Connect(Sender: TObject);
begin
StatusBar1.SimpleText:='已经连接';
Panel1.Color:=clBlue;
end;
procedure TFSMTP.NMSMTP1Disconnect(Sender: TObject);
begin
if StatusBar1<>nil then begin
StatusBar1.SimpleText:='断开连接';
Panel1.Color:=clRed;
end;
end;
procedure TFSMTP.ButtonAddClick(Sender: TObject);
begin
if OpenDialog1.Execute then
ListBoxAttachments.Items.Add(OpenDialog1.FileName);
end;
procedure TFSMTP.ButtonRemoveClick(Sender: TObject);
begin
ListBoxAttachments.Items.Delete(ListBoxAttachments.ItemIndex);
end;
procedure TFSMTP.ButtonSendClick(Sender: TObject);
{var
i_sum,i_count:integer;
s_To:string;
begin
i_sum:=0;i_count:=0;
with DBGrid1.DataSource.DataSet do
if (isempty=false) and (recordcount>0) then begin
Application.CreateForm(TFormSending, FormSending);
FormSending.Show;
FormSending.Label1.Caption:='共'+inttostr(recordcount)+'封邮件';
FormSending.Label4.Caption:=FormSending.Label1.Caption;
DisableControls;
first;
while not eof do begin
s_To:=Query1.FindField('电子邮箱').asstring;
i_sum:=i_sum+1;
if (trim(s_to)='')and(pos('@',s_To)<=0) then begin
i_count:=i_count+1;
FormSending.Label3.Caption:='目前共有'+inttostr(i_count)+'封空白的邮件地址';
FormSending.Label6.Caption:=FormSending.Label3.Caption;
end
else begin
FormSending.Label2.Caption:='正在发送第'+inttostr(i_sum)+'封邮件... ... ... ...';
FormSending.Label5.Caption:=FormSending.Label2.Caption;
Editto.Text:=s_to;
// EditBCC.Text:=s_to;
// EditCC.Text:=s_to;
NMSMTP1.PostMessage.FromAddress:=EditAddress.Text;
NMSMTP1.PostMessage.FromName:=EditName.Text;
NMSMTP1.PostMessage.Subject:=EditSubject.Text;
NMSMTP1.PostMessage.ToAddress.Text:=Editto.Text;
// NMSMTP1.PostMessage.ToBlindCarbonCopy.Add(EditBCC.Text);
// NMSMTP1.PostMessage.ToCarbonCopy.Add(EditCC.Text);
NMSMTP1.PostMessage.Attachments.AddStrings(ListBoxAttachments.Items);
NMSMTP1.PostMessage.Body.Assign(MemoMail.Lines);
NMSMTP1.SendMail; //
// ts_CC.Add(s_To);
end;
next;
end;
EnableControls;
end;
ShowMessage('邮件发送完毕！#1');
FormSending.Close;//}
//---------------------------------------------------
var
s_To:string;
// ts_To: TStrings;
begin
// ts_To:=TStringList.Create;
// ts_To.Clear;
with DBGrid1.DataSource.DataSet do begin
first;
DBGrid1.DataSource.DataSet.DisableControls;
while not eof do begin
s_To:=Query1.FindField('电子邮箱').asstring;
if (trim(s_To)<>'')and(pos('@',s_To)>0) then begin
//ts_To.Add(s_To);
Memo1.Lines.Add(s_To);
end;
next;
end;
first;
DBGrid1.DataSource.DataSet.EnableControls;
end;
NMSMTP1.PostMessage.FromAddress:=EditAddress.Text;
NMSMTP1.PostMessage.FromName:=EditName.Text;
NMSMTP1.PostMessage.Subject:=EditSubject.Text;
NMSMTP1.PostMessage.ToAddress.Text:=Memo1.Text;
//NMSMTP1.PostMessage.ToAddress.AddStrings(ts_To);
//NMSMTP1.PostMessage.ToAddress.Text:=s_To;
//NMSMTP1.PostMessage.ToAddress.Add(Editto.Text);
//NMSMTP1.PostMessage.ToBlindCarbonCopy.AddString(ts_BCC.Text);
//NMSMTP1.PostMessage.ToBlindCarbonCopy.Add(EditBCC.Text);
//NMSMTP1.PostMessage.ToCarbonCopy.AddStrings(ts_CC);
//NMSMTP1.PostMessage.ToCarbonCopy.Add(EditCC.Text);
NMSMTP1.PostMessage.Attachments.AddStrings(ListBoxAttachments.Items);
NMSMTP1.PostMessage.Body.Text:=MemoMail.Text;
//NMSMTP1.PostMessage.Body.Assign(MemoMail.Lines);
//NMSMTP1.PostMessage.Body.AddStrings(MemoMail.Lines);
NMSMTP1.SendMail;
ShowMessage('邮件发送完毕！#1');//}
end;
procedure TFSMTP.NMSMTP1EncodeStart(Filename: String);
begin
StatusBar1.SimpleText:='Encoding'+Filename;
end;
procedure TFSMTP.NMSMTP1EncodeEnd(Filename: String);
begin
StatusBar1.SimpleText:='Finished Encoding'+Filename;
end;
procedure TFSMTP.NMSMTP1ConnectionFailed(Sender: TObject);
begin
ShowMessage('连接失败');
end;
procedure TFSMTP.NMSMTP1ConnectionRequired(var Handled: Boolean);
begin
if MessageDlg('Connection Required Connect ?',
mtConfirmation,mbOkCancel,0)=mrOk then begin
Handled:=TRUE;
NMSMTP1.Connect;
end;
end;
procedure TFSMTP.NMSMTP1Failure(Sender: TObject);
begin
StatusBar1.SimpleText:='错误';
end;
procedure TFSMTP.NMSMTP1HostResolved(Sender: TComponent);
begin
StatusBar1.SimpleText:='Host Resolved';
end;
procedure TFSMTP.NMSMTP1InvalidHost(var Handled: Boolean);
var TmpStr:String;
begin
if inputquery('Invalid Host!','Specify a new host:',TmpStr) then
begin
NMSMTP1.Host:=TmpStr;
Handled:=True;
end;
end;
procedure TFSMTP.NMSMTP1PacketSent(Sender: TObject);
begin
StatusBar1.SimpleText:=IntToStr(NMSMTP1.BytesSent)
+'bytes of'+IntToStr(NMSMTP1.BytesTotal)+'sent';
end;
procedure TFSMTP.NMSMTP1RecipientNotFound(Recipient: String);
begin
ShowMessage('Recipient'+''''+Recipient+''''+'not found');
end;
procedure TFSMTP.NMSMTP1SendStart(Sender: TObject);
begin
StatusBar1.SimpleText:='发送邮件';
end;
procedure TFSMTP.NMSMTP1Success(Sender: TObject);
begin
StatusBar1.SimpleText:='成功';
end;
procedure TFSMTP.NMSMTP1HeaderIncomplete(var handled: Boolean;
hiType: Integer);
begin
ShowMessage('Header Incomplete.');
end;
procedure TFSMTP.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
NMSMTP1.Abort;
end;
procedure TFSMTP.ButtonConnection2Click(Sender: TObject);
begin
if ButtonConnection2.Caption='连接' then begin
NMSMTP1.Host:=EditHost.Text;
NMSMTP1.Port:=StrToInt(EditPort.Text);
NMSMTP1.UserId:=EditUserId.Text;
NMSMTP1.Connect;
Panel1.Color:=clBlue;
ButtonConnection2.Caption:='断开';
end
else begin
NMSMTP1.Disconnect;
Panel1.Color:=clRed;
ButtonConnection2.Caption:='连接';
end;
end;
procedure TFSMTP.FormShow(Sender: TObject);
begin
//DataMod.TableDepartment.Open;
if gs_potence[Self.Tag] = '2' then begin
ButtonSend.Enabled := False;
end;
Query1.Open;
QDepartKind.Open;
//ButtonConnection2.Click;
end;
procedure TFSMTP.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//DataMod.TableDepartment.Close;
Query1.Close;
QDepartKind.Close;
//ButtonConnection2.Click;
Action:=CaFree;
end;
procedure TFSMTP.Button1Click(Sender: TObject);
begin
if NMSMTP1.Verify(Edit1.Text) then
// ShowMessage(Edit1.Text+' verified')
else
ShowMessage(Edit1.Text+' not verified');
end;
procedure TFSMTP.DBLookupComboBox1Click(Sender: TObject);
begin
Query1.Filter:='部门分类='+vartostr(DBLookupComboBox1.KeyValue);
end;
procedure TFSMTP.Button2Click(Sender: TObject);
begin
Self.Close;
end;
end.