对不起大家,怪我没有说清楚,代码部分如下:
procedure TForm1.Button1Click(Sender: TObject);
begin
if not OpenDialog1.Execute then
Exit;
//如果没有选择文件则退出
ListBox1.Items.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if ListBox1.Items.Count = 0 then
exit;
if SaveDialog1.Execute then
//选择了保存文件
ListBox1.Items.SaveToFile(SaveDialog1.FileName);
end;
地址列表文件其实就是一个文本文件，每一行写入一个Email地址，通过TlistBox组件的LoadFromFile和SaveToFile即可完成导入导出操作。
然后看看菜单代码：
procedure TForm1.N1Click(Sender: TObject);
var
s: string;
begin
s := InputBox('输入对话框', '请输入邮件地址：', '@');
if (Length(s) > 5) and (Pos('@', s) < Pos('.', s)) then
ListBox1.Items.Add(s);
end;
添加号码菜单执行以上代码。
procedure TForm1.N2Click(Sender: TObject);
begin
ListBox1.DeleteSelected;
end;
删除所选菜单执行以上代码。
procedure TForm1.N3Click(Sender: TObject);
begin
ListBox1.Clear;
end;
清空列表菜单执行以上代码。
接下来开始重点邮件发送的代码了：
procedure TForm1.Button3Click(Sender: TObject);
var
i: integer;
begin
if ListBox1.Items.Count = 0 then
begin
showmessage('发送列表为空，群发失败！');
exit;
end;
if me_content.Text = '' then
//检测邮件是否有内容
begin
showmessage('输入邮件内容！');
exit;
end;
Button3.Enabled := False;
if cb_authen
tication.Checked then
//服务器验证
begin
IdSMTP1.Authen
ticationType := atLogin;
//设置认证模式
IdSMTP1.Username := le_user.Text;
//用户名
IdSMTP1.Password := le_pass.Text;
//密码
end else
begin
IdSMTP1.Authen
ticationType := atNone;
end;
IdSMTP1.Host := le_smtp.Text;
//主机地址
IdSMTP1.Port := StrToIntDef(le_port.Text, 25);
//如果转换错误默认25
IdSMTP1.Connect;
//连接
try
Tag := 1;
//设置中断标志
for i := 0 to ListBox1.Items.Count - 1do
begin
//循环发送
if Tag = 0 then
exit;
//如果中断则退出群发
SendEmail(ListBox1.Items.Strings);
//这个函数我们在后面介绍
IdSMTP1.Send(IdMessage1);
//发送
ListBox1.ItemIndex := i;
StatusBar1.SimpleText := Format('正在发送... (%d/%d) %s', [i, ListBox1.Items.Count - 1, ListBox1.Items.Strings]);
Application.ProcessMessages;
//循环期间处理进程消息
end;
finally
Tag := 0;
IdSMTP1.Disconnect;
//断开连接
Button3.Enabled := True;
end;
StatusBar1.SimpleText := '发送完成...';
end;
为了可以随时中断发送，我们需要设置一个全局标志，这里我们直接利用了Tform的Tag属性来完成，这种方法可以省掉一个全局变量的申明和初始化它的值，因而中断按钮的代码就非常简单了，一句Tag := 0;即可。
其中我们用到了SendEmail()函数代码如下：
function TForm1.SendEmail(aAddr: string): boolean;
begin
IdMessage1.Body.Assign(me_content.Lines);
//内容
IdMessage1.From.Text := le_email.Text;
IdMessage1.ReplyTo.EMailAddresses := le_email.Text;
//回复地址
IdMessage1.Recipients.EMailAddresses := aAddr;
//发送地址
IdMessage1.Subject := le_title.Text;
//标题
end;
这个函数就是我们用来设置发送的邮件信息的，循环中每封邮件的发送地址都不一样，因而封装此函数方便使用。
保存参数的代码：
procedure TForm1.Button5Click(Sender: TObject);
begin
//保存配置
with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'comm.ini')do
begin
WriteString('comm', 'smtp', le_smtp.Text);
WriteString('comm', 'port', le_port.Text);
WriteString('comm', 'user', le_user.Text);
WriteString('comm', 'pass', le_pass.Text);
WriteString('comm', 'email', le_email.Text);
WriteBool('comm', 'pass', cb_authen
tication.Checked);
end;
end;
请各位高手帮忙!!!
