哪有群发邮件的源程序下载或者能否告诉我具体实现方法

我循环简单写了一个，好像效果不是很好
（我每封邮件的内容不一样）

解决方案 »

  1.   

    unit USMTP;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ComCtrls, Buttons, StdCtrls, Psock, NMsmtp, Db, DBTables, ExtCtrls,Grids, DBGrids, DBClient, Provider, DBCtrls;typeTFSMTP = 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;varFSMTP: TFSMTP;implementationuses DataModoule,UnitSending,p_fandp;{$R *.DFM}procedure TFSMTP.ButtonConnectClick(Sender: TObject);beginNMSMTP1.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);beginNMSMTP1.Disconnect;ButtonConnect.Enabled:=True;ButtonDisConnect.Enabled:=False;end;procedure TFSMTP.NMSMTP1Connect(Sender: TObject);beginStatusBar1.SimpleText:='已经连接';Panel1.Color:=clBlue;end;procedure TFSMTP.NMSMTP1Disconnect(Sender: TObject);beginif StatusBar1<>nil then beginStatusBar1.SimpleText:='断开连接';Panel1.Color:=clRed;end;end;procedure TFSMTP.ButtonAddClick(Sender: TObject);beginif OpenDialog1.Execute thenListBoxAttachments.Items.Add(OpenDialog1.FileName);end;procedure TFSMTP.ButtonRemoveClick(Sender: TObject);beginListBoxAttachments.Items.Delete(ListBoxAttachments.ItemIndex);end;procedure TFSMTP.ButtonSendClick(Sender: TObject);{vari_sum,i_count:integer;s_To:string;begini_sum:=0;i_count:=0;with DBGrid1.DataSource.DataSet doif (isempty=false) and (recordcount>0) then beginApplication.CreateForm(TFormSending, FormSending);FormSending.Show;FormSending.Label1.Caption:='共'+inttostr(recordcount)+'封邮件';FormSending.Label4.Caption:=FormSending.Label1.Caption;DisableControls;first;
      

  2.   

    while not eof do begins_To:=Query1.FindField('电子邮箱').asstring;i_sum:=i_sum+1;if (trim(s_to)='')and(pos('@',s_To)<=0) then begini_count:=i_count+1;FormSending.Label3.Caption:='目前共有'+inttostr(i_count)+'封空白的邮件地址';FormSending.Label6.Caption:=FormSending.Label3.Caption;endelse beginFormSending.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;//}//---------------------------------------------------vars_To:string;// ts_To: TStrings;begin// ts_To:=TStringList.Create;// ts_To.Clear;with DBGrid1.DataSource.DataSet do beginfirst;DBGrid1.DataSource.DataSet.DisableControls;while not eof do begins_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);beginStatusBar1.SimpleText:='Encoding'+Filename;end;procedure TFSMTP.NMSMTP1EncodeEnd(Filename: String);beginStatusBar1.SimpleText:='Finished Encoding'+Filename;end;procedure TFSMTP.NMSMTP1ConnectionFailed(Sender: TObject);beginShowMessage('连接失败');end;procedure TFSMTP.NMSMTP1ConnectionRequired(var Handled: Boolean);beginif MessageDlg('Connection Required Connect ?',mtConfirmation,mbOkCancel,0)=mrOk then beginHandled:=TRUE;NMSMTP1.Connect;end;end;procedure TFSMTP.NMSMTP1Failure(Sender: TObject);beginStatusBar1.SimpleText:='错误';end;procedure TFSMTP.NMSMTP1HostResolved(Sender: TComponent);beginStatusBar1.SimpleText:='Host Resolved';end;procedure TFSMTP.NMSMTP1InvalidHost(var Handled: Boolean);var TmpStr:String;beginif inputquery('Invalid Host!','Specify a new host:',TmpStr) thenbeginNMSMTP1.Host:=TmpStr;Handled:=True;end;end;procedure TFSMTP.NMSMTP1PacketSent(Sender: TObject);beginStatusBar1.SimpleText:=IntToStr(NMSMTP1.BytesSent)+'bytes of'+IntToStr(NMSMTP1.BytesTotal)+'sent';end;procedure TFSMTP.NMSMTP1RecipientNotFound(Recipient: String);beginShowMessage('Recipient'+''''+Recipient+''''+'not found');end;procedure TFSMTP.NMSMTP1SendStart(Sender: TObject);beginStatusBar1.SimpleText:='发送邮件';end;procedure TFSMTP.NMSMTP1Success(Sender: TObject);beginStatusBar1.SimpleText:='成功';end;procedure TFSMTP.NMSMTP1HeaderIncomplete(var handled: Boolean;hiType: Integer);beginShowMessage('Header Incomplete.');end;procedure TFSMTP.FormCloseQuery(Sender: TObject; var CanClose: Boolean);beginNMSMTP1.Abort;end;procedure TFSMTP.ButtonConnection2Click(Sender: TObject);beginif ButtonConnection2.Caption='连接' then beginNMSMTP1.Host:=EditHost.Text;NMSMTP1.Port:=StrToInt(EditPort.Text);NMSMTP1.UserId:=EditUserId.Text;NMSMTP1.Connect;Panel1.Color:=clBlue;ButtonConnection2.Caption:='断开';endelse beginNMSMTP1.Disconnect;Panel1.Color:=clRed;ButtonConnection2.Caption:='连接';end;end;procedure TFSMTP.FormShow(Sender: TObject);begin//DataMod.TableDepartment.Open;if gs_potence[Self.Tag] = '2' then beginButtonSend.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);beginif NMSMTP1.Verify(Edit1.Text) then// ShowMessage(Edit1.Text+' verified')elseShowMessage(Edit1.Text+' not verified');end;procedure TFSMTP.DBLookupComboBox1Click(Sender: TObject);beginQuery1.Filter:='部门分类='+vartostr(DBLookupComboBox1.KeyValue);end;procedure TFSMTP.Button2Click(Sender: TObject);beginSelf.Close;end;end.　
      

  3.   

    我用的是SMTP(有验证),不知道如何确定发送是否成功,象邮件地址错或者其他错误.