一个群发邮件的DELPHI代码

Tags: /超级猛料/Network.网络通讯/电子邮件/ Date Created:

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;

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;

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;

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;

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.