邮件群发软件？

一个群发邮件的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.
base64编码：对HTML中的图片，SWF等任何文件进行编码：
/Base64编码
//对参数TMemoryStrema中的字节流进行Base64编码，编码后的结果
//保存在Encoded中，函数返回编码长度
function EncodeBASE64(Encoded, Decoded: TMemoryStream): Integer;
const
  _Code64: String[64] =('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/');
var
  i:LongInt;
  b:array[0..2279] of Byte;
  j,k,l,m,n,Quads:Integer;
  Stream: string[76];
  EncLine: String;
begin
  EnCoded.Clear;
  Stream := '';
  Quads := 0;
  J := Decoded.Size div 2280; //每2280字节流为一组进行编码
  Decoded.Position := 0;
  //对前J*2280个字节流进行编码
  for I := 1 to J do
  begin
    Decoded.Read(B, 2280);
    for M := 0 to 39 do
    begin
      for K := 0 to 18 do
      begin
        L:= 57*M + 3*K;
        Stream[Quads+1] := _Code64[(B[L] div 4)+1];
        Stream[Quads+2] := _Code64[(B[L] mod 4)*16 + (B[L+1] div 16)+1];
        Stream[Quads+3] := _Code64[(B[L+1] mod 16)*4 + (B[L+2] div 64)+1];
        Stream[Quads+4] := _Code64[B[L+2] mod 64+1];
        Inc(Quads, 4);
        if Quads = 76 then
        begin
          Stream[0] := #76;
          EncLine := Stream+#13#10;
          Encoded.Write(EncLine[1], Length(EncLine));
          Quads := 0;
        end;
      end;
    end;
  end;  //对以2280为模的余数字节流进行编码
  J := (Decoded.Size mod 2280) div 3;
  for I := 1 to J do
  begin
    Decoded.Read(B, 3);
    Stream[Quads+1] := _Code64[(B[0] div 4)+1];
    Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
    Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + (B[2] div 64)+1];
    Stream[Quads+4] := _Code64[B[2] mod 64+1];
    Inc(Quads, 4);
    //每行76个字符
    if Quads = 76 then
    begin
      Stream[0] := #76;
      EncLine := Stream+#13#10;
      Encoded.Write(EncLine[1], Length(EncLine));
      Quads := 0;
    end;
  end;
  //"="补位
  if (Decoded.Size mod 3) = 2 then
  begin
    Decoded.Read(B, 2);
    Stream[Quads+1] := _Code64[(B[0] div 4)+1];
    Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
    Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + 1];
    Stream[Quads+4] := '=';
    Inc(Quads, 4);
  end;  if (Decoded.Size mod 3) = 1 then
  begin
    Decoded.Read(B, 1);
    Stream[Quads+1] := _Code64[(B[0] div 4)+1];
    Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + 1];
    Stream[Quads+3] := '=';
    Stream[Quads+4] := '=';
    Inc(Quads, 4);
  end;  Stream[0] := Chr(Quads);
  if Quads > 0 then
  begin
    EncLine := Stream+#13#10;
    Encoded.Write(EncLine[1], Length(EncLine));
  end;
  Result := Encoded.Size;
end;

调试易

邮件群发软件？

解决方案 »