Delphi7中群发Email邮件的方法

本文实例讲述了Delphi7中群发Email邮件的方法。分享给大家供大家参考。具体分析如下：

这段时间需要对所有参加考试的考生将考生信息及考试信息通过电子邮件群发，经过多次调试，算是成功了，发来给大家参考一下：

总的思路是：

1、安装局域网版的邮件服务器，并通过设置DNS使得给服务器能给网外用户发送电邮，这方面的软件比较多，例如WinWebMail就不错，可以从官网下载；
 
2、需要使用到的控件：Indy10.0.15,可以通过百度搜索下载；
 
3、设置需要发送的电子邮箱服务器及账号信息

function setEmailInfo:integer; //返回值0：邮箱设置失败；1：邮箱设置成功

var

  selectStr:string;

  thisresult:integer;

begin

  thisresult := 0;

  //设置账户

      IdSMTP1.AuthType := atNone; //或者是atSASL;

      IdSMTP1.Host := hostString;

      IdSMTP1.Username := userNameString;

      IdSMTP1.Password := passWordString;

      try

        IdSMTP1.connect;

        thisresult := 1;

       

        if not IdSMTP1.Authenticate then

         begin

          showmessage('发送邮箱账号验证失败！请检查SMTP账户设置！');

          thisresult := 0;

         end

      except

        showmessage('SMTP服务器连接失败！请检查SMTP账户设置及网络是否正常！');

        thisresult := 0;

      end

    end;

  result := thisresult;

end;

procedure sendEmailOnce(emailusername:string;

    formAddress:string;receiptRecipientAddress:string;sendtoAdd:string;emailSubject:string);

begin

  MsgKsbkxx.From.Name := emailusername;     //邮件发送人姓名

  MsgKsbkxx.From.Address := formAddress; //邮件发送人地址

  MsgKsbkxx.ReceiptRecipient.Address := receiptRecipientAddress; 

     //回复地址，可以与邮件发送人地址不同

  MsgKsbkxx.Recipients.EMailAddresses := sendtoAdd; //发送地址？

  MsgKsbkxx.Sender.Address := formAddress; //sendtoAdd;  //邮件发送至......地址

  MsgKsbkxx.Subject := emailSubject;  //主题

  MsgKsbkxx.Body.Assign(emailMemo.Lines);  //邮件内容

  IdSMTP1.Send(MsgKsbkxx);  //发送邮件指令

end;

//根据字符串Separator的表示将字符串s分隔为若干个字符串，存入rs字符串列表中

procedure SeparateTerms2(s:string;Separator:string;var rs:TStringList);

var

  AStr: string;

  idx: Integer;

  ASubStr: string;

begin

  AStr := Trim(s);

  while Pos(Separator, AStr) > 0 do

  begin

    idx := Pos(Separator, AStr);

    ASubStr := Copy(AStr, 1, idx - 1);

    rs.Add(ASubStr);

    AStr := Copy(AStr, idx + 1, Length(AStr));

  end;

 if AStr+'a' <> 'a' then  rs.Add(AStr); //如果存在剩余的字符串，则将其存入字符串列表中

end;

 

//判断某个字符串是否符合电邮邮件地址标准

//正确：返回ok，错误返回error

function emailAddressYesOrNo (emailAddress:String):string;

var

  getStrings:TStringList;

  getYesOrNo:string;

begin

  getYesOrNo := 'error';

  getStrings := TStringList.Create;

  SeparateTerms2(emailAddress,'@',getStrings);

  if getStrings.Count=2 then

    begin

      getStrings.Clear;

      SeparateTerms2(emailAddress,'.',getStrings);

      if getStrings.Count>1 then  getYesOrNo := 'ok';

    end;

  getStrings.Free;

  result := getYesOrNo;

end;

procedure bEmailKsxxClick;

var

  AccordAmount,i,j,tag:integer;

  emailusername,formAddress,sendtoAdd,emailSubject,receiptRecipientAddress,selectStr:string;

begin

  //判断数据表里面是否有需要发送电子邮件的数据，如果有则发送

  if Bmb.RecordCount >0 then

    AccordAmount := Bmb.RecordCount

  else

    exit;

  //

  //获取账户信息,一般存放在数据表或INI文件中

  emailusername :=  userNameString; //发送邮件人

  formAddress := fromAddressString;   //发送邮件地址

  receiptRecipientAddress := receiptRecipientAddressString;  //回复邮件地址

  emailSubject := emailSubjectString; //邮件主题

 //

  tag := 1;  //标志位：发送出错则停止

  i:=1;  //发送邮件的总数

  j:=0;  //让进度条逐步递进的记录处理条数

  list1.Clear; //显示已经成功发送电子邮件的学员信息

  //判断是否能与设置的邮箱连接,如果返回值为1，则获取邮件内容及相关设置并发送

  if setEmailInfo = 1 then

    begin

      Pb.BlockSize := 1;

      Pb.Max := AccordAmount ;

      Formsjtj.Refresh;

      Bmb.First;

      try

       while (not tBmb.Eof) do

        begin

          //判断邮件地址是否为空且是否符合电邮规范，如都满足条件则给该地址发送电邮

          if Bmb.FieldByName('s_emailAddress').AsString+'a' <> 'a' then

            begin

              //获取发送邮件的内容

              emailMemo.Clear;

              ..........................

              //设置邮件信息，如发送邮件错误，则直接退出

              if tag=0 then exit;

              //发送邮件

              sendtoAdd :=  trim(Bmb.FieldByName('s_emailAddress').AsString); //需要发送至...邮箱

              if emailAddressYesOrNo(sendtoAdd)= 'ok' then  //检查电子邮件格式是否正确

                begin

                  sendEmailOnce(emailusername,formAddress,receiptRecipientAddress,sendtoAdd,emailSubject); //发送邮件

                  i := i+1;       //计数器加1

                  list1.Items.Add(......);  //将已经成功发送电邮的考生信息放在列表中

                end;

              //

            end;

          //每发送50封邮件停滞2s钟

          if (i mod 50) = 0 then sleep(2000);

          dm_sjtj.ListBmb.next;

          Application.ProcessMessages ; //循环中处理进程信息

          //刷新进度指示

          j := j+1;

          PB.Progress:=j;

          PB.StepIt ;

          PB.Refresh;

        end;

      finally

        tag := 0;

        IdSMTP1.Disconnect;

      end;

    end;

  showmessage('共发送 '+intToStr(i-1)+' 封邮件。');

end;

① 滥发电邮是国家所不允许的
② 由于群发电邮是绝大多数电邮提供商都控制，往往2封电邮之间必须要有一段时间的延迟，建议自行架设邮件服务器
③ 由于Indy控件只有atNone和atSASL两种模式，架设好邮件服务器后，需要设置不需要验证的IP地址及账号；
④ 由于内部邮件地址无法获得电邮回复，因此往往回复地址与发信地址设置为不同。现在出现的一个问题就是通过浏览器打开邮件无法回复，但是通过Foxmail接收邮件后可以获得回复。这点需要注意。

希望本文所述对大家的Delphi程序设计有所帮助。