www.pudn.com > 邮件群发程序1.2.rar > SendMail.pas

unit SendMail; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ComCtrls, DB, ADODB, Buttons,NMSMTP, Menus; 
 
type 
  TfrmMailsend = class(TForm) 
    GroupBox3: TGroupBox; 
    chkDb: TRadioButton; 
    GroupBox1: TGroupBox; 
    mailList: TMemo; 
    ADODataSet1: TADODataSet; 
    chkText: TRadioButton; 
    OpenDialog1: TOpenDialog; 
    BitBtn1: TBitBtn; 
    SaveDialog1: TSaveDialog; 
    PopupMenu1: TPopupMenu; 
    N1: TMenuItem; 
    BitBtn2: TBitBtn; 
    ADOQuery1: TADOQuery; 
    BitBtn3: TBitBtn; 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure FormCreate(Sender: TObject); 
    procedure chkDbClick(Sender: TObject); 
    procedure chkTextClick(Sender: TObject); 
    procedure BitBtn1Click(Sender: TObject); 
    procedure N1Click(Sender: TObject); 
    procedure BitBtn2Click(Sender: TObject); 
    procedure BitBtn3Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
    procedure getMailList(); 
    procedure queryMailList(); 
    procedure getStartDate(); 
    procedure setFileAdd(); 
  end; 
 
var 
  frmMailsend: TfrmMailsend; 
  mailBox:TNMSMTP; 
  startDates,endDates,isQuery:integer; 
  pro:TProgressBar; 
  procedure InitMail(); 
  procedure FinalMail(); 
  procedure setMailCont(); 
 
implementation 
 
uses mail,IniFiles; 
 
{$R *.dfm} 
 
procedure TfrmMailsend.FormClose(Sender: TObject; 
  var Action: TCloseAction); 
begin 
     free; 
     clearSta; 
     frmMain.StatusBar1.Panels[1].Text:=''; 
     if pro.Position>0 then 
        pro.Position:=0; 
end; 
 
procedure TfrmMailsend.setFileAdd(); 
var 
   ff:TextFile; 
   fn:string; 
   str:string; 
begin 
   fn:=ExtractFilePath(Paramstr(0))+'fileadd.txt'; 
   if not FileExists(fn) then exit; 
   mailBox.PostMessage.Attachments.Clear; 
   AssignFile(ff,fn); 
   Reset(ff); 
   try 
       while Not Eof(ff) do 
       begin 
            Readln(ff,str); 
            if Trim(str)<>'' then 
                mailBox.PostMessage.Attachments.Add(str); 
       end; 
   finally 
       Closefile(ff); 
   end; 
end; 
 
procedure TfrmMailsend.getStartDate(); 
var 
     ini:TiniFile; 
     fn:string; 
begin 
     fn:=ExtractFilePath(Paramstr(0))+'mail.ini'; 
     ini:=TiniFile.Create(fn); 
     try 
        startDates:=trunc(ini.ReadDateTime('DATEQUERY','STARTDATE',now)); 
        endDates:=trunc(ini.ReadDateTime('DATEQUERY','ENDDATE',now)); 
        isQuery:=ini.ReadInteger('DATEQUERY','ISCHECK',0); 
     finally 
        ini.Free; 
     end; 
end; 
 
procedure TfrmMailsend.queryMailList(); 
var 
   sql:string; 
   mail:string; 
   num:string; 
   ini:TiniFile; 
   fn:string; 
begin 
     fn:=ExtractFilePath(Paramstr(0))+'mail.ini'; 
     ini:=TiniFile.Create(fn); 
     try 
        startDates:=trunc(ini.ReadDateTime('DATEQUERY','STARTDATE',now)); 
        isQuery:=ini.ReadInteger('DATEQUERY','ISCHECK',0); 
     finally 
        ini.Free; 
     end; 
   if isQuery=1 then 
     sql:='select * from email where inputdate>'+inttostr(startDates) 
   else 
     sql:='select * from email'; 
   ADOQuery1.SQL.Clear; 
   ADOQuery1.Close; 
   ADOQuery1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0; Data Source='+ 
          ExtractFilePath(Paramstr(0))+'db\GroupMail.mdb;Jet OLEDB:Database Password=820745'; 
   ADOQuery1.SQL.Add(sql); 
   ADOQuery1.Prepared; 
   ADOQuery1.Open; 
   frmMain.StatusBar1.Panels[0].Text:=inttostr(ADOQuery1.RecordCount); 
   ADOQuery1.Close; 
end; 
 
procedure TfrmMailsend.getMailList(); 
var 
    sSql:string; 
    sMail:string; 
    numRecord:integer; 
begin 
    clearSta; 
    getStartDate; 
    mailList.Lines.Clear; 
    if isQuery=1 then 
          sSql:='select * from email where inputdate>='+inttostr(startDates)+' and inputdate<='+IntToStr(endDates) 
    else 
          sSql:='select * from email'; 
    ADODataSet1.Close; 
    ADODataSet1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ 
        ExtractFilePath(paramstr(0))+'db\GroupMail.mdb;Jet OLEDB:Database Password=820745'; 
    ADODataSet1.CommandType:=cmdText; 
    ADODataSet1.CommandText:=sSql; 
    ADODataSet1.Open; 
    numRecord:=ADODataSet1.RecordCount; 
    ADODataSet1.First; 
    while (not ADODataSet1.Eof) do 
    begin 
        sMail:=ADODataSet1.FieldByName('mails').AsString; 
        mailList.Lines.Add(sMail); 
        ADODataSet1.Next; 
    end; 
    ADODataSet1.Close; 
    frmMain.StatusBar1.Panels[0].Text:='已经打开了邮件列表'; 
    frmMain.StatusBar1.Panels[2].Text:='有邮件地址:'+IntToStr(numRecord)+'条'; 
    GroupBox1.Caption:='邮件列表:'+IntToStr(numRecord); 
end; 
 
procedure TfrmMailsend.FormCreate(Sender: TObject); 
begin 
    getMailList; 
end; 
 
procedure TfrmMailsend.chkDbClick(Sender: TObject); 
begin 
   getMailList; 
end; 
 
procedure TfrmMailsend.chkTextClick(Sender: TObject); 
var 
  ff:TextFile; 
  txtFn:string; 
  str:string; 
begin 
     mailList.Lines.Clear; 
     clearSta; 
     OpenDialog1.Filter:='文本文件(*.txt)|*.txt'; 
     if OpenDialog1.Execute then 
     begin 
         txtFn:=OpenDialog1.FileName; 
         //AssignFile(ff,txtFn); 
         //Reset(ff); 
       try 
         //while not Eof(ff) do 
               //begin 
               //    Readln(ff,str); 
               //    if trim(str)<>'' then 
               //          mailList.Lines.Add(str); 
               //end; 
               mailList.Lines.LoadFromFile(txtFn); 
       finally 
         //closeFile(ff); 
       end; 
     end; 
     frmMain.StatusBar1.Panels[2].Text:='EMAIL地址有:'+IntToStr(mailList.Lines.Count)+'条'; 
     GroupBox1.Caption:='群发邮件列表如下:'+IntToStr(mailList.Lines.Count); 
 
end; 
 
procedure InitMail(); 
var 
   ini:TiniFile; 
   fn:string; 
   sHost,sUser,sFromAddress,sFromName,sTitle:string; 
   nPort:integer; 
begin 
    fn:=ExtractFilePath(Paramstr(0))+'mail.ini'; 
    ini:=TiniFile.Create(fn); 
    sHost:=ini.ReadString('MAILINFO','HOST',''); 
    sUser:=ini.ReadString('MAILINFO','USER',''); 
    nPort:=ini.ReadInteger('MAILINFO','PORT',25); 
    sFromAddress:=ini.ReadString('MAILINFO','FROMEMAIL',''); 
    sFromName:=ini.ReadString('MAILINFO','FROMNAME',''); 
    sTitle:=ini.ReadString('MAILCONT','MAILTITLE',''); 
 
    mailBox:=TNMSMTP.Create(nil); 
    mailBox.Host:=sHost; 
    mailBox.Port:=nPort; 
    mailBox.UserID:=sUser; 
    mailBox.PostMessage.ToAddress.Clear; 
    mailBox.PostMessage.ToCarbonCopy.Clear; 
    mailBox.PostMessage.ToBlindCarbonCopy.Clear; 
    mailBox.PostMessage.Body.Clear; 
    mailBox.PostMessage.FromAddress:=sFromAddress; 
    mailBox.PostMessage.FromName:=sFromName; 
    mailBox.PostMessage.Subject:=sTitle; 
    ini.Free; 
end; 
 
procedure FinalMail(); 
begin 
    mailBox.Disconnect; 
    mailBox.Free; 
    frmMain.StatusBar1.Panels[0].Text:='Disconnected to NMSMTP...'; 
end; 
 
procedure TfrmMailsend.BitBtn1Click(Sender: TObject); 
var 
     j:integer; 
     sMail:string; 
     nCoutMail:integer; 
begin 
     pro:=TProgressBar.Create(frmMain.StatusBar1); 
     pro.Parent:=frmMain.StatusBar1; 
     pro.Left:=1; 
     pro.Top:=3; 
     pro.Height:=frmMain.StatusBar1.Height-3; 
     pro.Width:=frmMain.StatusBar1.Panels[0].Width; 
 
     pro.Position:=1; 
     pro.StepBy(1); 
     pro.Max:=mailList.Lines.Count-1; 
 
     nCoutMail:=0; 
     frmMain.StatusBar1.Panels[0].Text:='try connect to NMSMTP...'; 
     InitMail; 
     setFileAdd; 
     try 
     mailBox.Connect; 
     if mailBox.Connected then 
     begin 
          frmMain.StatusBar1.Panels[1].Text:='连接NMSMTP成功,正在发邮件...'; 
        setMailCont; 
          mailBox.PostMessage.ToAddress.Clear; 
          for j:=0 to mailList.Lines.Count-1 do 
          begin 
              sMail:=mailList.Lines[j]; 
              //mailBox.PostMessage.ToAddress.Clear; 
              if mailBox.PostMessage.ToAddress.Count<1 then 
                    mailBox.PostMessage.ToAddress.Add(sMail) 
              else 
                    mailBox.PostMessage.ToCarbonCopy.Add(sMail); 
                    pro.Position:=j; 
              //mailBox.SendMail; 
              //Inc(nCoutMail); 
              //frmMain.StatusBar1.Panels[1].Text:='已发邮件: '+inttostr(nCoutMail)+'封'; 
          end; 
          mailBox.SendMail; 
          pro.Position:=0; 
     end; 
     //pro.Position:=mailList.Lines.Count-1; 
     frmMain.StatusBar1.Panels[1].Text:='发送邮件成功，共发了'+inttostr(mailList.Lines.Count)+'封邮件'; 
     FinalMail; 
     except 
         on E:exception do 
            frmMain.StatusBar1.Panels[0].Text:=E.Message; 
     end; 
end; 
 
procedure setMailCont(); 
var 
    fs:TextFile; 
    sCont,sFn:string; 
begin 
    sFn:=ExtractFilePath(Paramstr(0))+'mailbody.txt'; 
    AssignFile(fs,sFn); 
    Reset(fs); 
    while (not Eof(fs)) do 
    begin 
        Readln(fs,sCont); 
        mailBox.PostMessage.Body.Add(sCont); 
    end; 
    CloseFile(fs); 
end; 
 
procedure TfrmMailsend.N1Click(Sender: TObject); 
begin 
    SaveDialog1.Filter:='文本文件(*.txt)|*.txt'; 
    if SaveDialog1.Execute then 
        mailList.Lines.SaveToFile(SaveDialog1.FileName+'.txt'); 
end; 
 
procedure TfrmMailsend.BitBtn2Click(Sender: TObject); 
begin 
    mailList.Lines.Clear; 
end; 
 
procedure TfrmMailsend.BitBtn3Click(Sender: TObject); 
begin 
     queryMailList; 
end; 
 
end.