如何做群發郵件呢 如何改寫這段代碼讓它能通過呢 (100分)

  • 主题发起人 主题发起人 goddy
  • 开始时间 开始时间
G

goddy

Unregistered / Unconfirmed
GUEST, unregistred user!
我做過發單個郵件的﹐但是發多個有問題
如果有發多個有一個地址不存在就會有問題
而且﹐發多個有數量限制
如何解決呢
 
不會一個一個的發吧
 
这样写不行吗,好象可以,我也没好好测过
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress:=...;
NMSMTP1.PostMessage.FromName:=...;
NMSMTP1.PostMessage.Subject:=...;
NMSMTP1.PostMessage.ToAddress.Assign(Memo1.Lines);
NMSMTP1.PostMessage.Attachments.Assign(Memo2.Lines);
NMSMTP1.PostMessage.Body.Assign(Memo3.Lines);
NMSMTP1.SendMail;
 
indy可以。
Name@sina.com,Name2@sina.com,Name3@sina.com
收件人用逗号隔开即可
 
想知道!
 
to pnljh 如果有一個發不行了就全不行了如何做呢
 
不知道一次發一個﹐用多線程行不行呢
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1702834
這裡有例子和源碼,以及詳細程序編寫文檔
 
to soonstar 沒有呀
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1751112
最新版
 
for(int i=0;i<count;i++)
{
IdMsgSend->Recipients->EMailAddresses =RE2->Lines->Strings;
try
{
Form1->IdMsgSend->Subject ="我的QQ:87789559 寫delphi就可以";
Form1->SMTP->Connect();
Form1->SMTP->Send(Form1->IdMsgSend);
}
catch(Exception &e)
{
RichEdit1->Lines->Add(RE2->Lines->Strings+" "+e.Message);

}
Form1->SMTP->Disconnect();
//Application->ProcessMessages();


}
發几個后就會出現: error:
521 User has too many connections to SMTP; please try again later
我每發一個都重新連接啊

 
学习学习!!1
 
邮件群发的基本原理是直接发送到邮件地址的邮箱中,这需要通过DNS解析到邮件地址
所在的邮件服务器中MX地址,否则对于ESMTP的服务器来说会因为需要AUTH而拒绝接收
邮件。这样就直接使用标准的SMTP命令发送邮件了。

我开发一个邮件群发的程序,但是不想在做下取了,有需要可以联系。
支持WEB页面搜索邮件地址
多线程发送...

联系:nospam_idevcn@hotmail.com(去掉'nospam_')
 
//---------------------------------------------------------------------------
//(R)CopyRight CodeChina workroom ,inc 2002
//單元名稱:主控介面
//程式名稱:微雨郵件群發
//作 者:辛佳雨
//開始時間:2002.06.06
//最後修改:2002.06.07
//備註:所有過程式都在此單元
//---------------------------------------------------------------------------
unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdMessage, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
IdComponent, IdUDPBase, IdUDPClient, IdDNSResolver, Gauges, Grids,Inifiles;

type
TfrmMain = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
Button1: TButton;
OpenDialog: TOpenDialog;
IdDNSResolver: TIdDNSResolver;
IdAntiFreeze1: TIdAntiFreeze;
IdSMTP: TIdSMTP;
IdMsgSend: TIdMessage;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
mmContent: TMemo;
edtFrom: TEdit;
edtSubject: TEdit;
btnSend: TButton;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
edtDns: TEdit;
edtHeader: TEdit;
Gauge: TGauge;
Label1: TLabel;
Label7: TLabel;
Label8: TLabel;
lblMailNum: TLabel;
lblWinNum: TLabel;
lblFailNum: TLabel;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
Minfo: TMemo;
butSetupOk: TButton;
StringGrid: TStringGrid;
butClose: TButton;
TabSheet5: TTabSheet;
RichEdit1: TRichEdit;
chk: TCheckBox;
procedure Button1Click(Sender: TObject);

procedure btnSendClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure butSetupOkClick(Sender: TObject);
procedure butCloseClick(Sender: TObject);
private
{ Private declarations }

procedure GetMxList(AMxList: TStringList; AQName: string);
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
intMailNum: integer=0;

implementation

{$R *.dfm}
function IsEMail(EMail: String): Boolean;
var
s: String;
ETpos: Integer;
begin
ETpos:= pos('@',EMail);
if ETpos > 1 then
begin
s:= copy(EMail,ETpos+1,Length(EMail));
if (pos('.',s) > 1) and (pos('.',s) < length(s)) then
begin
Result:= true
end else
begin
Result:= false;
end;
end
else begin
Result:= false;
end;
end;

//提取字串中指定子字串前的字串
Function Before( Src:string ; S:string ): string ;
Var
F: Word ;
begin
F:= POS(Src,S) ;
if F=0 then
Before := S
else
Before := COPY(S,1,F-1) ;
end ;

//提取字串中指定子字串後的字串
Function After(Src:string ; S:string ): string ;
Var
F: Word ;
begin
F := POS(Src,S);
if F=0 then
After := ''
else
After := COPY(S,F+length(src),length(s)) ;
end ;


procedure TfrmMain.Button1Click(Sender: TObject);
var
NewColumn: TListColumn;
mailfile:TStringList;
i,j:integer;
strSendName: string;
begin
j := 0;
if OpenDialog.Execute then
begin
mailfile := TStringList.Create;
try
mailfile.LoadFromFile(OpenDialog.FileName);
Gauge.Visible := true;
Gauge.MinValue :=0;

Gauge.MaxValue := mailfile.Count-1;
for i:=0 to mailfile.Count-1 do
begin
Gauge.Progress := i;
if isemail(mailfile.strings) then
begin
strSendName := Before('@',mailfile.strings);
StringGrid.Cells[0,intMailNum+1] := mailfile.strings;
StringGrid.Cells[1,intMailNum+1] := strSendName;
inc(intMailNum);
if intMailNum > 7 then
StringGrid.RowCount := StringGrid.RowCount + 1;
end;
end;
finally
mailfile.Free;
end;
lblMailNum.Caption := inttostr(intMailNum);
Gauge.Visible := false;
btnSend.Enabled := true;
end;

end;


//===================================

{ *****************************************************************************
這個過程是用來得到郵件特快專遞目的地伺服器名稱及優先順序別數,參數AMXList是用
 來接收結果值,AQName代表傳遞過來的功能變數名稱
*****************************************************************************}
procedure TfrmMain.GetMxList(AMxList: TStringList; AQName: string);
var
i: Integer;
begin
with IdDNSResolver do
begin
Host := edtDns.Text; { Host屬性用來指定功能變數名稱伺服器的位址,此處爲筆者所在地
的主功能變數名稱伺服器位址,你也可以指定任一可以快速訪問到的Internet上功能變數名稱伺服器
位址,要知道自己所在地的功能變數名稱伺服器位址,win98下通過winipcfg命令,win2000下
通過ipconfig /all即可查出。}
ReceiveTimeout := 10000; // 在指定的時間內得不到功能變數名稱伺服器的反饋,則視爲失敗。
ClearVars; // 清除前一次查詢所反饋回來的資源記錄

{ 構建此次查詢的頭部結構 }
with DNSHeader do
begin
Qr := False; // False 代表查詢
Opcode := 0; // 0代表標準功能變數名稱查詢
RD := True; //功能變數名稱伺服器可以進行遞迴查詢
QDCount := 1; //查詢的數量
end;

{ 構建要查詢的問題 }
DNSQDList.Clear;
with DNSQDList.Add do
begin
QName := AQName; //要查詢的功能變數名稱
QType := cMX; //QTYPE指定要查詢的資源記錄的種類,值爲cMX代表郵件交換記錄
QClass := cIN;
end;

ResolveDNS; //向功能變數名稱伺服器發出請求

{ 從功能變數名稱伺服器接收反饋的結果,將反饋回來的郵件伺服器名稱放在AMXList列表的Name部分,
郵件伺服器的優先順序別數放在Value部分。 }
for i := 0 to DNSAnList.Count - 1 do
AMxList.Add(DNSAnList.RData.MX.Exchange + '=' +
IntToStr(DNSAnList.RData.MX.Preference));
end;
end;



//====================================



{ 單擊"發送"按鈕時發送專遞郵件 }
procedure TfrmMain.btnSendClick(Sender: TObject);
var
iniFilePath,DBFlag: string;
iniSendSetup: TIniFile;
MxList: TStringList;
i: Integer;
strToAddr,QName, ThoughAddress: string;
FailNum,WinNum: integer;
begin
iniFilePath := ExtractFilePath(Application.Exename)+'SendMail.ini';
iniSendSetup := TIniFile.Create(iniFilePath);
iniSendSetup.WriteString('SendDoc','SendFrom',edtFrom.Text);
iniSendSetup.WriteString('SendDoc','Subject',edtSubject.Text);
iniSendSetup.WriteString('SendDoc','Content',mmContent.Text);
mmContent.Lines.SaveToFile(ExtractFilePath(Application.Exename)+'SendDoc.txt');
iniSendSetup.Free;
minfo.Text := '';
minfo.Text := #13+#10+'=============================================='
+ #13+#10+'微雨郵件群發 作者:辛佳雨'
+ #13+#10+'代碼中國網 http://www.codechina.net'
+ #13+#10+'此資訊由軟體使用者發出與本軟體作者無關!'
+ #13+#10;
strToAddr :='';
lblWinNum.Caption := '0';
lblFailNum.Caption := '0';
WinNum := 0;
FailNum := 0;
btnSend.Enabled := false;
Button1.Enabled := False;
if chk.Checked = false then
if edtHeader.Text = '' then
begin
showmessage('不採用高速發送的時候,發送功能變數名稱必須指定!');
btnSend.Enabled := true;
Button1.Enabled := true;
exit;
end;

if edtDns.Text = '' then
begin
showmessage('DNS設置不能爲空!');
btnSend.Enabled := true;
Button1.Enabled := true;
exit;
end else if edtFrom.Text = '' then
begin
showmessage('發件人地址不能爲空!');
btnSend.Enabled := true;
Button1.Enabled := true;
exit;
end else if isemail(edtFrom.Text)=false then
begin
showmessage('發件人地址格式不正確!');
btnSend.Enabled := true;
Button1.Enabled := true;
exit;
end else if edtSubject.Text = '' then
begin
showmessage('發信主題不能爲空!');
btnSend.Enabled := true;
Button1.Enabled := true;
exit;
end else if mmContent.Text = '' then
begin
showmessage('發信內容不能爲空');
btnSend.Enabled := true;
Button1.Enabled := true;
exit;
end;

minfo.Text :=mmContent.Text+minfo.Text;
Gauge.MinValue := 0;
Gauge.MaxValue := intMailNum - 1;
Gauge.Visible := true;
for i:=0 to intMailNum-1 do
begin
strToAddr := StringGrid.Cells[0,i+1];
{ 根據用戶所填寫的內容創建郵件 }
with IdMsgSend do
begin
Body.Assign(minfo.Lines); //郵件正文
From.Address := Trim(edtFrom.Text); //發件人地址
Recipients.EMailAddresses := Trim(strToAddr); //收件人地址
Subject := edtSubject.Text; //郵件主題
end;
{ 從輸入的收件人地址中取出郵箱功能變數名稱,利用前面的GetMxList過程得到目的地地址 }
QName := After('@',strToAddr);
MxList := TStringList.Create;
try
GetMxList(MxList, QName);
ThoughAddress := MxList.Names[0]; {取反饋回來的第一個伺服器爲目的地,讀者可
根據實際需要改進,比如說考慮到信件的優先順序或當你選擇的伺服器因繁忙而暫時
不能處理你的信件時,換用其他伺服器試試 }
finally
MxList.Free;
end;
{ 發送郵件 }
with IdSMTP do
begin
if chk.Checked then
begin
Host := ThoughAddress; // 將Host賦值爲目的地,這就是特快專遞與普通郵件的區別
end else
Host := edtHeader.Text; // 使用指定的
begin
end;
Port := 25; // smtp服務默認的埠爲25
try
Connect; //連接到伺服器
Send(IdMsgSend); //發送剛才創建的郵件
inc(WinNum);
Application.ProcessMessages;
StringGrid.Cells[2,i+1] := '發送成功!';
lblWinNum.Caption := inttostr(WinNum);
except
inc(FailNum);
Application.ProcessMessages;
StringGrid.Cells[2,i+1] := '發送失敗!';
lblFailNum.Caption := inttostr(FailNum);
end;
end;
Gauge.Progress := i;
IdSMTP.Disconnect;
end;
Gauge.Visible := false;
btnSend.Enabled := true;
Button1.Enabled := true;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
iniFilePath: string;
iniSendSetup: TIniFile;
begin
iniFilePath := ExtractFilePath(Application.Exename)+'SendMail.ini';
iniSendSetup := TIniFile.Create(iniFilePath);
edtDns.Text := iniSendSetup.ReadString('SendSetup','DNS','');
edtHeader.Text := iniSendSetup.ReadString('SendSetup','HEADER','');
edtFrom.Text := iniSendSetup.ReadString('SendDoc','SendFrom','');
edtSubject.Text := iniSendSetup.ReadString('SendDoc','Subject','');
try
mmContent.Lines.LoadFromFile(ExtractFilePath(Application.Exename)+'SendDoc.txt');
except
end;
if iniSendSetup.ReadString('SendSetup','HIGHSEND','1')='1' then
begin
chk.Checked := true;
end else
begin
chk.checked := false;
end;
iniSendSetup.Free;
stringGrid.Cells[0,0] := '電子信箱';
stringGrid.Cells[1,0] := '收件人';
stringGrid.Cells[2,0] := '發送狀態';
stringGrid.ColWidths[0] :=200;
stringGrid.ColWidths[1] :=170;
stringGrid.ColWidths[2] :=120;
end;

procedure TfrmMain.butSetupOkClick(Sender: TObject);
var
iniFilePath,DBFlag: string;
iniSendSetup: TIniFile;
begin
iniFilePath := ExtractFilePath(Application.Exename)+'SendMail.ini';
iniSendSetup := TIniFile.Create(iniFilePath);
iniSendSetup.WriteString('SendSetup', 'DNS', edtDns.Text);
iniSendSetup.WriteString('SendSetup','HEADER',edtHeader.Text);
if chk.Checked then
begin
iniSendSetup.WriteString('SendSetup','HIGHSEND','1');
end else
begin
iniSendSetup.WriteString('SendSetup','HIGHSEND','0');
end;
iniSendSetup.Free;
showmessage('設置保存成功!');

end;

procedure TfrmMain.butCloseClick(Sender: TObject);
begin
close;
end;

end.
上面的這段代碼通不過呀﹐很多屬性都沒有,在d6,d7 都通不過有些屬性delphi的幫助有
實際上沒有 誰幫help我呢
 
上面的源碼可以到這個下載
http://www.codechina.com/codelist.asp?id=2213
 
//---------------------------------------------------------------------------

#include <vcl.h>
#pragma hdrstop

#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------
/*
{ *****************************************************************************
这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数,参数AMXList是用
 来接收结果值,AQName代表传递过来的域名
*****************************************************************************}
*/
void TForm1::GetMxList(TStringList *AMxList, String AQName)
{
int i;
IdDNSResolver->Host= "202.101.107.55";
/*Host属性用来指定域名服务器的地址,此处为笔者所在地
的主域名服务器地址,你也可以指定任一可以快速访问到的Internet上域名服务器
地址,要知道自己所在地的域名服务器地址,win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。
*/
IdDNSResolver->ReceiveTimeout = 10000; // 在指定的时间内得不到域名服务器的反馈,则视为失败。
IdDNSResolver->ClearVars(); // 清除前一次查询所反馈回来的资源记录
// { 构建此次查询的头部结构 }
IdDNSResolver->DNSHeader->Qr= False; // False 代表查询
IdDNSResolver->DNSHeader->Opcode = 0; // 0代表标准域名查询
IdDNSResolver->DNSHeader->RD= True; //域名服务器可以进行递归查询
IdDNSResolver->DNSHeader->QDCount= 1; //查询的数量

// { 构建要查询的问题 }
IdDNSResolver->DNSQDList->Clear();
TQuestionItem *QuestionItem=IdDNSResolver->DNSQDList->Add();

QuestionItem->QName = AQName; //要查询的域名
QuestionItem->QType = cMX; //QTYPE指定要查询的资源记录的种类,值为cMX代表邮件交换记录
QuestionItem->QClass = cIN;
IdDNSResolver->ResolveDNS(); //向域名服务器发出请求
/*
{ 从域名服务器接收反馈的结果,将反馈回来的邮件服务器名称放在AMXList列表的Name部分,
邮件服务器的优先级别数放在Value部分。 }
*/
for(int i = 0 ;i<IdDNSResolver->DNSAnList->Count;i++ )
AMxList->Add(AnsiString(IdDNSResolver->DNSAnList->Items->RData.MX.Exchange) + "="+AnsiString(IdDNSResolver->DNSAnList->Items->RData.MX.Preference));

}
void __fastcall TForm1::btnSendClick(TObject *Sender)
{
TStringList *MxList=new TStringList();
int i;
String QName, ThoughAddress;
// { 根据用户所填写的内容创建邮件 }
IdMsgSend->Body->Assign(mmContent->Lines); //邮件正文
IdMsgSend->From->Address =edtFrom->Text.Trim(); //发件人地址
IdMsgSend->Recipients->EMailAddresses = edtTo->Text.Trim(); //收件人地址
IdMsgSend->Subject= edtSubject->Text.Trim(); //邮件主题
// { 从输入的收件人地址中取出邮箱域名,利用前面的GetMxList过程得到目的地地址 }
QName = edtTo->Text.SubString(edtTo->Text.Pos("@") + 1, edtTo->Text.Length());
try
{
GetMxList(MxList, QName);
ThoughAddress = MxList->Names[0];
/*{取反馈回来的第一个服务器为目的地,读者可
根据实际需要改进,比如说考虑到信件的优先级或当你选择的服务器因繁忙而暂时
不能处理你的信件时,换用其它服务器试试 }
*/
}
__finally
{
delete MxList;
}


// { 发送邮件 }
IdSMTP->Host= ThoughAddress; // 将Host赋值为目的地,这就是特快专递与普通邮件的区别
IdSMTP->Port= 25; // smtp服务默认的端口为25
IdSMTP->Connect(); //连接到服务器
try
{
IdSMTP->Send(IdMsgSend); //发送刚才创建的邮件
ShowMessage("发送完毕"); //发送完毕后提示
}
__finally
{
IdSMTP->Disconnect(); //断开服务器连接
}
}
//---------------------------------------------------------------------------
 
后退
顶部