|
1鱼币
一个群发软件的源码~~为什么单个邮件可以发~多个就出错~求高手点拨下,当输入多个邮件时发送出错提示
报错Authentication Failed,只发送一个时就成功,源码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, Menus;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Edit1: TEdit;
Memo1: TMemo;
Edit2: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Label8: TLabel;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Label9: TLabel;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
var filename:string;
begin
OpenDialog1.Execute;
filename:=OpenDialog1.FileName;
Label9.Caption:=filename;
TIdAttachment.Create(IdMessage1.MessageParts,filename);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
if not OpenDialog1.Execute then Exit; //如果没有选择文件则退出
ListBox1.Items.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
if ListBox1.Items.Count = 0 then exit;
if SaveDialog1.Execute then //选择了保存文件
ListBox1.Items.SaveToFile(SaveDialog1.FileName);
end;
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.Button6Click(Sender: TObject);
var
i,j :integer;
email:string;
begin
IdSMTP1.AuthenticationType:=atlogin;
IdSMTP1.Username:=trim(Edit5.Text);
IdSMTP1.Password:=trim(Edit6.Text);
IdSMTP1.Host:=trim(Edit4.Text);
IdSMTP1.Connect; //开始连接服务器
label8.Visible :=true ;
j:=ListBox1.Items.Count;
for i:=0 to j-1 do
begin
label8.Caption :='共'+inttostr(j)+'封邮件正在发送第'+inttostr(i+1)+'封邮件';
email:=trim(ListBox1.Items.Strings[i]);
IdMessage1.Body.Clear;
IdMessage1.Subject:=Edit1.Text;
IdMessage1.Body.Text := Memo1.Text;
IdMessage1.Body.Assign(Memo1.Lines);
IdMessage1.Recipients.EMailAddresses:=email;
IdMessage1.From.Address:=Edit2.Text;
idsmtp1.Authenticate; //自动身份验证
idSMTP1.Send(IdMessage1); //发送邮件
end;
IdSMTP1.Disconnect; //断开连接
showmessage('发送完毕!');
label8.Visible :=false ;
end;
end.
|
|