各位大虾，怎样群发邮件？

[bubble]

在数据库中存有多个人的e-mail地址，我想实现以下功能：
我可以在程序中设置用于发送邮件的邮箱和邮箱密码，发送邮件的头文字和邮件内容，然后可以选择可以给这些用户群发邮件，邮件中自动将用户名以逗号分隔并且在所有的用户名后隔一个空格将头文字添加到后面然后换行自动添入邮件内容。
多谢各位！

[527xm]

idsmtp1.Username:=;
idsmtp1.Password:='';
idsmtp1.Port:=25;
idsmtp1.Host:=;
try
try
IdSMTP1.Connect(500);
except
showmessage('发件服务器忙请稍后再试！');
end;

IdMessage1.Body.Text:='asd';
IdMessage1.Subject:=trim('23日统计');
idmessage1.From.Address:=;
idmessage1.From.Name:='xx;
idmessage1.Recipients.EMailAddresses:='[e-mail]';
//IdMessage1.Recipients.


TIdAttachment.Create(idmessage1.MessageParts,'c:\display.txt');
idsmtp1.Send(IdMessage1);


showmessage('成功');
//Ado_Address.Next;
finally
idsmtp1.DisconnectSocket;
Idsmtp1.Disconnect;
end;
end;

[lyguo]

学习

[bubble]

大虾，能否加个注释？多谢！

[Kshape]

http://delphifans.com/SoftView/SoftView_528.html

自己看看啊

[Kshape]

//如果上上面的连接不行，给我消息我给你发
//下面是发送单元的代码
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;

[Kshape]

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.

[ghy412]

学习