首页 | 社区 | 博客 | 招聘 | 文章 | 新闻 | 下载 | 读书 | 代码
亲,您未登录哦! 登录 | 注册

一个群发邮件的DELPHI代码

打印文章

分享到:
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.

本栏文章均来自于互联网,版权归原作者和各发布网站所有,本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )

编程爱好者论坛

本栏最新文章