Delphi7中群发Email邮件的方法 Delphi7中群发Email邮件的方法

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;