使用indy不能发送邮件,怎样才能发送邮件呢 ( 积分: 100 )

  • 主题发起人 主题发起人 dali2000
  • 开始时间 开始时间
D

dali2000

Unregistered / Unconfirmed
GUEST, unregistred user!
部分门户网站的免费邮箱专门针对indy组件做了限制,用indy10 在163,sina, tom 都发不出。请问delphi如何才能发邮件?
 
这个问题很早就解决了,是要改一个什么东西,很简单的,大富翁里有你找找吧!!
 
接分


问题:使用indy9不能发送邮件的兄弟注意了,这里有解决方法! ( 积分:10, 回复:71, 阅读:2843 )
分类:Internet/TCPIP ( 版主:luyear, robertcool )
来自:lzf1010, 时间:2006-2-21 14:26:00, ID:3359545 [显示:小字体 | 大字体]

1、
找到procedure TIdSMTP.Send(AMsg: TIdMessage);这个函数将SendCmd('RSET');这行注销
2、IdMessageCoderMIME这个单元,将下面的常量IndyMIMEBoundary,IndyMultiPartAlternativeBoundary,IndyMultiPartRelatedBoundary改成你自己需要的就可以了。

从这里可以看出,部分门户网站的免费邮箱专门针对indy组件做了限制!现在borland已经决定出售delphi了,这些门户还暗地里捅上一刀,真是阴险!


来自:zqw0117, 时间:2006-2-21 14:50:02, ID:3359594
顶一下,其实很早之前就有好多邮件服务器把indy特征记录了,一般用Indy原始代码都发不出去的,呵呵,自己动手丰衣足食!改改就不错!请问一句,那个SendCmd('RSET')是什么 意思?通讯的时候是不是可以忽略这个cmd?


来自:lzf1010, 时间:2006-2-21 14:52:52, ID:3359599
是要注释掉这一行才行,不注释掉这行会报异常!

是最近两个星期才出现发不出邮件的现象的,之前一直没问题。


来自:lzf1010, 时间:2006-2-21 14:54:23, ID:3359601
呵呵,2006自带那个indy10就没问题,不过还是建议要改掉那三个常量,因为说不准那天就又被封杀了


来自:zqw0117, 时间:2006-2-21 15:06:25, ID:3359614
呵呵,明白了。
恩,常量一定要改,建议一劳永逸的改成一个自动生成初始化值的常量,在单元的initialization中动态初始化,这样每次执行程序都会不同:)嘻嘻。更保险。


来自:lzf1010, 时间:2006-2-21 15:24:17, ID:3359648
看来indy开发组已经注意到自己的控件被人封杀了,2006自带的Indy10现在这三个常量已经是每次执行程序都不同的了,而且也是放在initialization中动态初始化


来自:liyinwei, 时间:2006-2-23 10:08:37, ID:3361695
支持!支持!
非常感谢楼主!


来自:王思佳, 时间:2006-2-23 10:43:11, ID:3361757
非常感谢!


来自:Tuatara, 时间:2006-2-24 14:11:34, ID:3363252
THS


来自:play123456, 时间:2006-2-27 10:50:52, ID:3365374
我写了个程序测试了一下Indy9的smtp控件,发现是这样的:
1.对有的邮件服务器,这样的写法是没有问题的,比如使用foxmail服务器版做的服务端。
2.对另一些邮件服务器的确会出错。但把顺序改一下,先进行身份验证auth,然后再发送RSET指令就正确了。
3.换用Indy10后就正确了。仔细比较了Indy9和Indy10的这部分代码,觉得是9版本实现的有问题造成的。


来自:CoolSlob, 时间:2006-2-28 14:15:11, ID:3366849
难道非要回复了才能收藏此贴吗:)

测试一下


来自:vmao, 时间:2006-2-28 15:03:10, ID:3366927
[:(]还是不太明白,不过确实最近我用Indy9写的程序发不了邮件了~~


来自:lzf1010, 时间:2006-2-28 15:22:21, ID:3366970
to vmao:
在你project所在文件夹中新建一个文件夹,将IdMessageClient.pas,IdMessageCoderMIME.pas这两个文件copy到这个新建的文件夹中,然后按我所说的方法修改这两个文件,最后在IDE中打开Project->Options->Directories/Conditionals->Search path中加入这个新建的文件夹所在的路径,重新编译就可以了。


来自:vmao, 时间:2006-2-28 15:24:30, ID:3366979
1.SendCmd('RSET')是什么 意思?通讯的时候是不是可以忽略这个cmd?
2.那三个常量有什么作用,把它的value随便换成什么都可以吗?


来自:lzf1010, 时间:2006-2-28 16:05:32, ID:3367090
1、SendCmd('RSET')一定要注销,否则会报异常
2、那三个常量随便换成什么都可以,不过一定要长,最好是随机的GUID(在IDE的代码编辑器里同时按下Ctrl+shift+G可以产生GUID)!因为这三个常量是用来分割邮件内容的的分隔符。


来自:vmao, 时间:2006-2-28 16:27:00, ID:3367132
我以前是好的,现在老报这个错误,是怎么回事~
550 5.7.1 Unable to relay for user@domain.com


来自:lzf1010, 时间:2006-2-28 16:31:43, ID:3367136
按照我说的来修改也不行吗?


来自:vmao, 时间:2006-2-28 16:41:09, ID:3367152
是的,我已经改过了~~,奇怪了~ 我是直接改的Indy的代码,没有复制过来,把搜索地址指向了原来的Source文件夹


来自:vmao, 时间:2006-2-28 16:48:33, ID:3367165
procedure TSendMailf.BtnSendClick(Sender: TObject);
var inifile:tinifile;
sSender:string; //发件人地址
i,j,iCount:integer;
sReceipter,sAddress:string;//收件人和地址
sBody : string; //邮件内容,有替代
begin
Unsend.Lines.Clear;
//1.删除空行
i:=0;
while (i<self.txtRecipters.Lines.Count) do
begin
if self.txtRecipters.Lines.Strings = '' then
begin
self.txtRecipters.Lines.Delete(i);
i:=i-1;
end;
i:=i+1;
end;

if self.txtRecipters.Lines.Count = 0 then
begin
showmessage('没有收件人!');
abort;
end;

//1 总进度
self.ProgressBar.Max := self.txtRecipters.Lines.Count;
self.ProgressBar.Step :=1;
self.ProgressBar.Position :=0;

//1.读取配置文件
inifile:=tinifile.Create(extractfilepath(application.exename)+'/setting.ini');
try
self.IdSMTP.AuthenticationType := atLogin;
self.IdSMTP.Host := inifile.ReadString('Setting','HostName','');
self.IdSMTP.Port := inifile.ReadInteger('Setting','port',25);
self.IdSMTP.Username := inifile.ReadString('Setting','UserName','');
self.IdSMTP.Password := inifile.ReadString('Setting','Password','');
sSender := inifile.ReadString('Setting','Sender','');
finally
inifile.free;
end;

//2.构建Idmessage
self.IdMessage.Subject := trim(self.txtTitle.Text);
self.IdMessage.From.Text := sSender;

//3.添加附件
for i:=0 to self.ListView.Items.Count-1 do
begin
TidAttachment.Create(idMessage.MessageParts ,self.ListView.Items.Caption);
end;

//
iCount := 0;

try
IdSMTP.Connect(5000);
for i:=0 to self.txtRecipters.Lines.Count -1 do
begin
sReceipter := '';
sAddress := '';
sBody := self.txtBody.Lines.Text;
sReceipter := copy(self.txtRecipters.Lines.Strings,1,pos(',',self.txtRecipters.Lines.Strings)-1);
sAddress := copy(self.txtRecipters.Lines.Strings,length(sReceipter)+2,length(self.txtRecipters.Lines.Strings));
if sReceipter='' then sReceipter := copy(sAddress,1,pos('@',sAddress)-1); //修正receipter;
self.IdMessage.Recipients.EMailAddresses := sAddress;
sBody := stringreplace(sBody,'[Receipter]',sReceipter,[rfReplaceAll]);
self.IdMessage.Body.Text := sBody;
try
IdSMTP.Send(IdMessage);
Unsend.Lines.Add(self.txtRecipters.Lines.Strings);
iCount := iCount +1;
except
raise;
//错误地址以后处理
end;
self.ProgressBar.Position := self.ProgressBar.Position + self.ProgressBar.Step;
end;
finally
IdSMTP.Disconnect;
end;
//
showmessage('发送完成!');
end;


来自:lzf1010, 时间:2006-2-28 16:50:58, ID:3367172
你应该复制出来!!在新的文件夹里看到这两个文件的DCU生成了那些修改才算是生效了!


来自:vmao, 时间:2006-2-28 17:01:10, ID:3367193
我试试看吧~~


来自:vmao, 时间:2006-2-28 20:01:42, ID:3367392
我自己先查查吧,因为我发现用foxmail发邮件也是同样的错误,可能是我的邮件服务器或我的设置有问题.


来自:lzf1010, 时间:2006-2-28 20:41:36, ID:3367431
按我的方法修改后还是不行吗?你是用什么邮箱?


来自:jtsnyj, 时间:2006-3-9 14:54:52, ID:3376889
真的感谢lzf1010,为这件事我折腾了好几天了,也没弄好,上大富翁看看,果然有结果,哈哈!我用的是delphi6,他没有IdMessageCoderMIME.pas单元,怎么办呀?


来自:jtsnyj, 时间:2006-3-9 15:37:58, ID:3376970
lzf1010我收到的邮件内容有的是html格式,怎么办?你怎样收正文呀?


来自:hxb_leiyuan, 时间:2006-3-16 14:39:05, ID:3383925
如果 charset=text/html
建议使用HTML Component进行解析,从http://www.pbear.com/下载


来自:迷恋婷, 时间:2006-3-24 11:12:31, ID:3392092
那个html转网页显示的控件有没有中文帮助阿?小弟不太会用:(


来自:wutianlong, 时间:2006-3-27 9:20:23, ID:3394458
我用indy9发邮件怎么没有问题呢,你们说的是指哪几个门户网站的邮件服务器不行,我也想看看是不是我的也存在问题


来自:xdel, 时间:2006-4-3 10:22:40, ID:3402602
lzf1010:
我已照你的方法修改了,163.com可以成功发往163.com,但不能发往其他邮箱,如21cn.com、sina.com等,出现‘requested action not taken:smtp13‘ 错误,如何解决?


来自:w_anghe, 时间:2006-4-4 10:17:38, ID:3403828
非常感谢楼主提供宝贵信息。


来自:lzf1010, 时间:2006-4-4 10:47:24, ID:3403875
xdel:
我测试了一下,好像没有出现你说的错误


来自:xdel, 时间:2006-4-4 16:37:33, ID:3404457
lzf1010:
有时行,有时不行,不知何解?


来自:pllink_qyd, 时间:2006-4-4 16:50:40, ID:3404487
不錯。。


来自:wutianlong, 时间:2006-4-7 12:52:36, ID:3407603
鎴戞渶杩戠敤ipsmtp鍙戠粰鍥藉?瀹㈡埛鐨勯偖浠舵湁浜涗細鏈夌┖鐧?杩欐槸涓轰粈涔?
鍝?綅澶т緺鐭ラ亾,缁欎釜鎻愮ず,璋㈣阿


来自:xdel, 时间:2006-4-15 20:06:47, ID:3416359
lzf1010:
用indy9 demo 自带的MailClient 发送邮件,在MailClient中接收,发现只能接收主题等,不能接收'Body',(带附件的除外),大家有无这种情况,如何解决?


来自:chlf6312, 时间:2006-5-20 23:47:57, ID:3448568
不错不错 问题已经解决 十分感谢


来自:chlf6312, 时间:2006-5-21 0:31:49, ID:3448579
发送也没问题了,但是出现了新的问题,就是不能重复发送,也就是当发送一次后,修改一下内容(比如主题、信件内容、或者收件人之类的)之后再点击发送按钮,就出错了
出错信息是:
Access violation at address 0046BC81 in module
程序主体如下:
IdMessage1.Clear;
IdMessage1.Body.Assign(Contents.Lines); //Text
IdMessage1.From.Text := SenderAddress.Text; //Address
IdMessage1.Recipients.EMailAddresses := ReceiverAddress.Text;
IdMessage1.Subject := Title.Text;
//IdMessage1.ContentType := 'Text';

IdSMTP1.AuthenticationType := atLogin;
IdSMTP1.Username := SenderName.Text;
IdSMTP1.Password := Password.Text;
IdSMTP1.Host := HostName.Text;
IdSMTP1.Port := 25;

try
try
StatusBar1.SimpleText := 'Connecting...';
StatusBar1.Update;
IdSMTP1.Connect;
except
MessageBox(0, '连接服务器失败', nil, MB_OK or MB_ICONERROR);
StatusBar1.SimpleText := 'Connect Failed';
StatusBar1.Update;
Exit;
end;
StatusBar1.SimpleText := 'Connected';
StatusBar1.Update;
try
StatusBar1.SimpleText := 'Sending...';
StatusBar1.Update;
IdSMTP1.Send(IdMessage1);
StatusBar1.SimpleText := 'Send Successed';
StatusBar1.Update;
MessageBox(0, '邮件已经发送成功', nil, MB_OK or MB_ICONINFORMATION);
except
StatusBar1.SimpleText := 'Send Failed';
StatusBar1.Update;
MessageBox(0, '邮件发送失败', nil, MB_OK or MB_ICONERROR);
end;
finally
IdMessage1.Free;
IdSmtp1.Free;
end;
请高手赐教啊


来自:shiwei-l, 时间:2006-5-23 13:29:01, ID:3450556
我用的是delphi6,他没有IdMessageCoderMIME.pas单元,怎么办呀?
我改了IdMessageClient.pas单元的MultiPartBoundary, MultiPartAlternativeBoundary,MultiPartRelatedBoundary三个常量结果不可以,但是按楼主说的改Delphi7的就可以了,请问delphi6的怎么办,可不可以卸载delphi 6的indy装上delphi 7的indy????,那又如何卸载delphi 6的indy???


来自:lzf1010, 时间:2006-5-23 14:33:29, ID:3450729
indy9不是有for D6的吗?安装包里有说明如何删除旧版INDY的方法,你按照上面说的就可以了


来自:shiwei-l, 时间:2006-5-23 14:56:08, ID:3450766
To:lzf1010,你好,我找不indy9的组件,你能否传一份给我,对了,我不会删除旧版indy,你能否告之,谢谢了,你可以去http://www.delphibbs.com/delphibbs/dispq.asp?lid=3448531拿份


来自:shiwei-l, 时间:2006-5-23 16:32:53, ID:3450989
问题搞定了,但是怎么发送Html正文呢


来自:ranran, 时间:2006-8-7 16:57:36, ID:3527745
我没有改,为什么现在可以了?确实要改吗?


来自:ranran, 时间:2006-8-7 17:20:58, ID:3527777
测试了一下午,发现都能收,不知道还要不要改!


来自:lzf1010, 时间:2006-8-18 21:28:15, ID:3539318
我只是说不能发,没有说不能收


来自:ranran, 时间:2006-8-19 8:53:07, ID:3539432
有时能发出有时不能发,TOM的每天只能发五封。。。163这两天又不能发了。


来自:ranran, 时间:2006-8-19 11:34:49, ID:3539555
就是改了也不行(163),另:
procedure TIdSMTP.Send(AMsg: TIdMessage);

procedure WriteRecipient(const AEmailAddress: TIdEmailAddressItem);
begin
SendCmd('RCPT TO:<' + AEMailAddress.Address + '>', [250, 251]); {Do not Localize}
end;

没有找到SendCmd('RSET');


来自:shiwei-l, 时间:2006-9-8 0:37:20, ID:3566283
我觉的还是用indy10,我就是用这个开发的


来自:davidtseng, 时间:2006-9-8 15:03:34, ID:3566859
我现在用indy10开发邮件客户端程序遇到 问题,哪位大侠帮助解决?
如何使用indy邮件组建通过 proxy发送邮件



来自:lzf1010, 时间:2006-9-15 18:37:53, ID:3573520
使用TIdSMTP、TIdIOHandlerStack、TIdSocksInfo就可以用代理发送邮件了!


来自:yeschoto21cn, 时间:2006-9-16 16:12:38, ID:3574009
如何用使用TIdSMTP、TIdIOHandlerStack、TIdSocksInfo进行使用代理发送邮件?


来自:lucky.gong, 时间:2006-12-8 23:45:37, ID:3641462
好多看不懂,现在又要用到各位说的东东.唉,要学的东西太多了.


来自:竹音, 时间:2006-12-11 18:13:15, ID:3643083
我通过这种方式,解决了163发不出的问题。但是gmail还是发不出去,发送报异常,E.message是一串随机值,形如“d19sm7049513and”。解决了的话开帖给分~~谢了


来自:ufo!, 时间:2006-12-11 20:09:12, ID:3643151
先查询dns,获取gmail的mx值的ip,然后可以用idsmtp直接发邮件给gmail,只是有时会被规类到垃圾邮件去。


来自:ARRAYlyf, 时间:2006-12-12 11:35:42, ID:3643533
哪位能提供一完整代码,并配上注释,让小弟学学啊?


来自:51zhan.com, 时间:2006-12-26 12:24:57, ID:3645622
我用indy10,也遇到问题,欢迎大家继续讨论.


来自:51zhan.com, 时间:2006-12-28 22:05:40, ID:3647827
这样改了也是白改,都不行, Smtp.Host := sMX;

function TfrmMain.GetMxList(vDns, vDomain: string): TstringList;
var
k: Integer;
IdDNS:TIdDnsResolver;
begin
Result := TstringList.Create;
IdDNS := TIdDnsResolver.Create(nil);
if vDns='' then vDns := '202.118.4.238';
IdDNS.Host := vDns;
IdDns.QueryRecords := [qtMX];
try IdDns.Resolve(vDomain);//(vDomain);
IdDns.Active;
for k := 0 to IdDns.QueryResult.Count-1 do
if IdDns.QueryResult[k] IS TMxRecord then
Result.Add(TMXRecord(IdDns.QueryResult[k]).ExchangeServer);
finally
IdDns.Free;
end;
end;



来自:LoveShanShan, 时间:2006-12-31 9:37:52, ID:3649397
改成任意常量都行么?


来自:lzf1010, 时间:2006-12-31 17:42:37, ID:3649785
gmail使用的是ssl链接,和普通的邮件服务器有点区别,修改一下属性值就可以了


来自:抵住诱惑, 时间:2007-1-1 10:56:00, ID:3649954
原来如此啊..



来自:51zhan.com, 时间:2007-1-3 21:03:56, ID:3651237



来自:l1_jun, 时间:2007-1-3 21:15:22, ID:3651242
看来以后用Indy的话,要注意一下了。


来自:51zhan.com, 时间:2007-1-4 14:33:41, ID:3651772
用新浪(sina)的smtp(smtp.sina.com.cn)依然发送不了,谁能够解决,就奖商他500大洋.


来自:lrpgdbbk, 时间:2007-4-25 9:28:48, ID:3706289
我前两天才发现我一直用的发邮件的程式用不了,原来如此。


来自:hrp123, 时间:2007-8-28 16:13:13, ID:3828116
lzf1010:

你的这个问题解决没有?我与碰到这个问题,能否共享下?


来自:go2u, 时间:2007-9-18 13:10:14, ID:3835129
我现在用indy10 在163,sina, tom 都发不出。哪位大侠有一劳永逸的办法。


来自:txbdir, 时间:2007-9-18 13:23:11, ID:3835140



来自:dali2000, 时间:2007-10-1 10:40:41, ID:3839352
来自:go2u, 时间:2007-9-18 13:10:14, ID:3835129
我现在用indy10 在163,sina, tom 都发不出。哪位大侠有一劳永逸的办法。

indy10又发不出去了?


来自:dali2000, 时间:2007-10-1 11:31:23, ID:3839355
有没有别的没被限制的发邮件的控件


来自:txbdir, 时间:2007-10-5 19:55:24, ID:3839892
楼主,请加我QQ85484058,有问题请教!


来自:dali2000, 时间:2007-10-18 11:39:02, ID:3843642
现在都不知用什么来发送邮件了!!!


来自:bigwell, 时间:2007-10-24 16:49:55, ID:3845630
也难怪的,太多人使用indy发垃圾邮件了
 
现在就是indy10 也发不了了
 
前几天用delphit7的TIdSMTP做了一个邮件发送小程序,通过163.com的SMTP发送,没有问题。
在此顺便请教高手一个问题:邮件发送进度怎么做?
 
留下邮箱发一个给你。
 
写indy的程序员确实很优秀,代码值得我反复学习.但是真正要自己写网络这方面的东东,还是要用winsock好,用winsock处理,其实代码变得很简单,效率也好.indy把很多东西都考虑进去,但是实际我们要用的不用那么多啦.

hying95:如果可以,也给我一个吧,我用不着,但是想欣赏一下您是怎么改的

55423726@qq.com
 
to 想高飞:
能不能把发送邮件代码贴出来学习.
我的邮箱:dali2000888@163.com
 
我刚刚用Indy10通过我的163邮箱给我的sina邮箱发送了一封邮件,能收到,能发送,没有任何问题!

估计楼主是滥发垃圾邮件,你的邮件符合垃圾邮件的要求,所以被邮件服务商给过滤掉了。如果是通过163的2006年9月以后申请的邮箱发送邮件的话,那是行不通的,请自己去阅读163的服务协议,从2006年9月以后,新注册的帐户不提供SMTP和POP3服务(好像是两个都不提供,不过可能我记得不清楚,也有可能是只拒绝提供SMTP服务)。
 
我的代码也很简单,如下而已:
begin
IdMessage1.From.Address := 'yu*****@163.com';
IdMessage1.Recipients.Add.Address := 'zqw****@sina.com';
IdMessage1.Sender.Address := 'yu*****@163.com';
IdMessage1.Body.Add('Test');
IdMessage1.Subject := 'Test';
IdSmtp1.Username := 'yu*****@163.com';
IdSMTP1.Password := '********************';
IdSMTP1.Connect;
try
IdSMTP1.Send(IdMessage1);
finally
IdSMTP1.Disconnect;
end;
end;
 
unit aMail1;

interface
uses
Windows, Messages, SysUtils, forms, Classes,
Dialogs, Wininet, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdEMailAddress;

var
SMTP: TIdSmtp;
Meg: TidMessage;

procedure SendMails(
F_Addres,//发件人地址
T_Addres,//收件人地址
FileName //附件
: string;
ZT //正文
: TStrings);stdcall;

procedure PopnSmtp(SupplierAddress:String;var Pop3_Addres, SMTP_Addres:
string); stdcall;

procedure FillPopnSmtp(SupplierAddress:String;var Pop3_Addres, SMTP_Addres:
string); stdcall;

Procedure SplitEmailAddress(EmailAddress:String; var ZH, Pop3_Addres,
SMTP_Addres: String);stdcall;


implementation

{$R PS.res}
//判断EMAIL是否有效
function IsVaildEmailAddr(EmailAddr:String):boolean;
var
Number,I:integer; //Number用于给字符'@'计数
TempStr:String;
begin
TempStr:=EmailAddr;
Number:=0;
for I:=1 to Length(TempStr) do
begin
if (TempStr ='@') then
INC(Number);
end;
if ((Number =0)or(Number >1)) then
Result:=False//如果不含有字符'@',或者其个数大于1,则不合法
else
begin
if ((TempStr [1]='@')or (TempStr [length(TempStr)]='@')) then
Result:=False//如果字符'@'的位置在字符串开头或者末尾,则不合法
else
begin
I:=pos('@',TempStr);//获取字符'@'在字符串当中的位置
delete(TempStr,1,I);//获取字符串中字符'@'后面的剩余子串
if (Length(TempStr)<3) then
Result:=False //如果剩余子串的长度小于3,则不合法
else
begin
if ((pos('.',TempStr)=0)or(pos('.',TempStr)=length(TempStr))
or (pos('.',TempStr)=1))then
Result:=False//如果剩余的子串当中不含有字符'.',或者其位置在//子串的开头或者末尾,则不合法
else
Result:=True; //以上的判断都通过,则表示地址字符串为合法
end;
end;
end;
end;

procedure FillPopnSmtp(SupplierAddress:String;var Pop3_Addres, SMTP_Addres:
string); stdcall;
var
PopAndSmtpFile:TextFile;
TableDir:String;
TempStr,PopServerAddr,SmtpServerAddr:String;
Ptn:Integer;
R: TResourceStream;
begin
R:=TResourceStream.Create(HInstance, 'Smtp', 'TXT');

TableDir:=ExtractFilePath(application.ExeName)+'popnsmtp.txt';
if not FileExists(TableDir) then R.SaveToFile('./popnsmtp.txt');

AssignFile(PopAndSmtpFile,TableDir);
ReSet(PopAndSmtpFile);
While Not Eof(PopAndSmtpFile) do
begin
Readln(PopAndSmtpFile,TempStr);
if (Pos(SupplierAddress,TempStr)=1) then
begin
Ptn:=Pos('<p>',TempStr);
Delete(TempStr,1,Ptn+2);
Ptn:=Pos('<s>',TempStr);
PopServerAddr:=Copy(TempStr,1,Ptn-1);
Pop3_Addres:=PopServerAddr;//POP3服务器地址
Delete(TempStr,1,Ptn+2);
SmtpServerAddr:=TempStr;
SMTP_Addres:=SmtpServerAddr;//SMTP服务器地址
break;
end;
end;

R.Free;
end;

procedure PopnSmtp(SupplierAddress:String;var Pop3_Addres, SMTP_Addres:
string); stdcall;
var
i: integer;
//PopAndSmtpFile:TextFile;
//TableDir:String;
TempStr,PopServerAddr,SmtpServerAddr:String;
Ptn:Integer;
MS: TMemoryStream;
R: TResourceStream;
tmpList: TStringList;
begin
i:=0;
tmpList:=TStringList.Create;
MS:=TMemoryStream.Create;
R:=TResourceStream.Create(HInstance, 'Smtp', 'TXT');
R.SaveToStream(MS);
tmpList.LoadFromStream(MS);
While i<TmpList.Count-1 do
begin
tempStr:=TmpList.Strings;

if (Pos(SupplierAddress,TempStr)=1) then
begin
Ptn:=Pos('<p>',TempStr);
Delete(TempStr,1,Ptn+2);
Ptn:=Pos('<s>',TempStr);
PopServerAddr:=Copy(TempStr,1,Ptn-1);
Pop3_Addres:=PopServerAddr;//POP3服务器地址
Delete(TempStr,1,Ptn+2);
SmtpServerAddr:=TempStr;
SMTP_Addres:=SmtpServerAddr;//SMTP服务器地址
break;
end;
end;

MS.Free;
tmpList.Free;
R.Free;
end;

Procedure SplitEmailAddress(EmailAddress:String; var ZH, Pop3_Addres,
SMTP_Addres: String);stdcall;
var
UserAccountStr:String;//用于保存用户帐号名称
SupplierStr:String;//用于保存电子邮件服务提供商的地址
Ptn:Integer; //保存符号@的位置
P,M: String;
begin
Ptn:=Pos('@',EmailAddress);
UserAccountStr:=Copy(EmailAddress,1,Ptn-1);
ZH:=UserAccountStr;
SupplierStr:=Copy(EmailAddress,Ptn+1,Length(EmailAddress)-Ptn);
SupplierStr:=LowerCase(SupplierStr);
FillPopnSmtp(SupplierStr,P,M);
Pop3_Addres:=P;
SMTP_Addres:=M;
end;

//检测机器是否登入网络
Function NetCheck: Boolean;
begin
Result := False;
if GetSystemMetrics(SM_NETWORK) <> 0 then //所有连入网的
Result := True;
end;

//检测填写Email地址的合法性
function CheckMailAddress(Text: string): boolean;
var
Index: integer;
lp: integer;
begin
Result := false;
if ((length(trim(Text)) > 20) or (Pos('.', Text) < 4))
or (Pos('.HTM', UpperCase(Text)) > 0) or (Pos('.HTML', UpperCase(Text)) > 0)
or (Pos('.ASP', UpperCase(Text)) > 0) or (Pos('.JSP', UpperCase(Text)) > 0) then exit;
for lp := 1 to length(Text) do
if (Ord(Text[lp]) > $80) and (Text[lp] <> '@') then exit;
if (Pos('.', Text) < Pos('@', Text) + 1) then exit;
Index := Pos('@', Text);
if (Index < 2) or (Index >= Length(Text)) then exit;
Result := true;
end;



procedure SendMails(
F_Addres,//发件人地址
T_Addres,//收件人地址
FileName //附件
: string;
ZT //正文
: TStrings);stdcall;
var
ZH,Pop_Addres,Smtp_Addres: String;

begin

if not CheckMailAddress(F_Addres) then
begin
messagedlg('输入的Eail地址不合法',mtConfirmation,[mbYes,mbNo],0);
exit;
end;

Try
SMTP:=TidSmtp.Create(nil);
Meg:=TidMessage.Create(nil);
SplitEmailAddress(F_Addres,ZH,Pop_Addres,Smtp_Addres);
SMTP.Host:=Smtp_Addres; //SMTP服务器地址
SMTP.AuthenticationType := atLogin; //保证登录模式为Login
SMTP.Username:=ZH; //邮箱帐号
SMTP.Password:='74123698';//邮箱密码
TIdAttachment.Create(Meg.MessageParts,FileName); //添加附件

with Meg do
begin
From.Address:=F_Addres; //发件人地址
Recipients.EMailAddresses:=T_Addres; //收件人地址
Subject:= '邮件标题';
Body.Text := 'ZT.Text'; //此处为邮件正文
CharSet := 'GB2312'; //保证附件正文汉字的正常显示
Body.Assign(ZT); //邮件正文
Priority:=mpHighest;
//CCList.EMailAddresses := edtCC.Text; {CC} //抄送
//BccList.EMailAddresses := edtBCC.Text; {BBC} //暗送
{if chkReturnReciept.Checked then //需要已读回执
begin //We set the recipient to the From E-Mail address
ReceiptRecipient.Text := From.Text;
end else
begin //indicate that there is no receipt recipiant
ReceiptRecipient.Text := '';
end; }
end;

if SMTP.AuthSchemesSupported.IndexOf('LOGIN')>-1 then
begin
SMTP.AuthenticationType :=atLogin; //连接前要保存为Login 上面己设,此处不必要
SMTP.Authenticate;
end;

if not NetCheck then exit; //是否连网

SMTP.Connect(); //连接SMTP服务器
SMTP.Authenticate;
SMTP.Send(Meg); //向服务器发送邮箱
finally
SMTP.Disconnect; //断开与服务器的连接
end;

SMTP.Free;
Meg.Free;
end;

end.

下面是PS.Res
foxmail.com.cn<p>pop.foxmail.com.cn<s>smtp.foxmail.com.cn
mail.bodachina.com<p>mail.bodachina.com<s>mail.bodachina.com
21cn.com<p>pop.21cn.com<s>smtp.21cn.com
sina.com<p>pop3.sina.com.cn<s>smtp.sina.com.cn
163.net<p>pop.163.net<s>smtp.163.net
163.com<p>pop.163.com<s>smtp.163.com
fm365.com<p>mail.fm365.com<s>mail.fm365.com
263.net<p>263.net<s>smtp.263.net
x263.net<p>pop.x263.net<s>smtp.x263.net
263.net.cn<p>263.net.cn<s>263.net.cn
elong.com<p>pop3.elong.com<s>smtp.elong.com
chinaren.com<p>pop.chinaren.com<s>
km169.net<p>email.km169.net<s>email.km169.net
cmmail.com<p>pop3.cmmail.com<s>smtp.cmmail.com
china.com<p>pop.china.com<s>smtp.china.com
cww.com<p>pop.china.com<s>smtp.china.com
eazier.com<p>pop.easier.com<s>smtp.eazier.com
sohu.com<p>pop3.sohu.com<s>smtp.sohu.com
fd21.com<p>pop.fd21.com<s>smtp.fd21.com
online.sh.cn<p>pop.citiz.net<s>smtp.citiz.net
yeah.net<p>pop.yeah.net<s>smtp.yeah.net
netease.com<p>pop.netease.com<s>smtp.netease.com
myrice.com<p>pop.myrice.com<s>smtp.myrice.com
wx88.net<p>mail.wx88.net<s>mail.wx88.net
email.com.cn<p>www.email.com.cn<s>www.email.com.cn
cn99.com<p>pop.cn99.com<s>
tonghua.com.cn<p>pop3.tonghua.com.cn<s>smtp.tonghua.com.cn
china1mail.com<p>mail.china1mail.com<s>
371.net<p>371.net<s>smtp.371.net
kali.com.cn<p>pop.kali.com.cn<s>smtp.kali.com.cn
focus.com.cn<p>pop3.focus.com.cn<s>smtp.focus.com.cn
8848.net<p>pop.8848.net<s>smtp.8848.net
ucs.com.tw<p>210.66.17.1<s>
mailbox.com.cn<p>email.com.cn<s>email.com.cn
990.net<p>pop.990.net<s>990.net
88998.com<p>202.100.222.86<s>202.100.222.86
ctn.com.cn<p>mail.ctn.com.cn<s>
2911.net<p>pop.2911.net<s>smtp.2911.net
soim.net<p>freemail.soim.com<s>freemail.soim.com
sh.soim.com<p>sh.soim.com<s>
777.net.cn<p>mail.777.net.cn<s>mail.777.net.cn
telekbird.com.cn<p>pop.telekbird.com.cn<s>smtp.telekbird.com.cn
btamail.net.cn<p>btamail.net.cn<s>btamail.net.cn
chinanew.com<p>chinanew.com<s>
gzyp21.net<p>gzyp21.net<s>gzyp21.net
freemail.online.tj.cn<p>freemail.online.tj.cn<s>freemail.online.tj.cn
363.net<p>363.net<s>smtp.363.net
w4f.com<p>pop.email.com.cn<s>smtp.email.com.cn
dl163.com<p>www.dl163.com<s>www.dl163.com
chinaxian.com<p>www.email.com.cn<s>www.email.com.cn
2888.com<p>2888.com<s>2888.com
yes100.com<p>pop.yes100.com<s>smtp.yes100.com
chinese.com<p>pop.chinese.com<s>smtp.chinese.com
yifan.net<p>yifan.net<s>yifan.net
china183.com<p>mail.china183.com<s>mail.china183.com
20520.com<p>pop.20520.com<s>smtp.20520.com
elawchina.com<p>pop3.elawchina.com<s>smtp.elawchina.com
fugao.net<p>pop.email.com.cn<s>smtp.email.com.cn
mybada.net<p>pop.mybada.net<s>smtp.mybada.net
gz168.net<p>email.gz168.net<s>email.gz168.net
kzinfo.net<p>mail.kzinfo.net<s>mail.kzinfo.net
7119.net<p>7119.net<s>smtp.7119.net
ccidnet.com<p>pop.ccident.com<s>smtp.ccident.com
cfe21.com<p>www.cfe21.com<s>www.cfe21.com
etang.com<p>pop.etang.com<s>smtp.etang.com
hnet.com.cn<p>pop.email.com.cn<s>smtp.email.com.cn
nethao.com<p>freemail.nethao.com<s>freemail.nethao.com
soyou.net<p>pop.soyou.net<s>smtp.soyou.net
newstar.com.cn<p>pop.emai.com.cn<s>smtp.email.com.cn
cityhot.com<p>citymail.cityhot.com<s>citymail.cityhot.com
dfworld.net<p>mail.dfworld.net<s>mail.dfworld.net
gzboy.com<p>www.email.com.cn<s>www.email.com.cn
fengyun.net<p>freemail.fengyun.net<s>freemail.fengyun.net
citiz.net<p>pop.citiz.net<s>smtp.citiz.net
tt.zj.cn<p>pop.email.com.cn<s>smtp.email.com.cn
100m.hl.cninfo.net<p>100m.hl.cninfo.net<s>100m.hl.cninfo.net
dg.163mail.net<p>dg.163mail.net<s>dg.163mail.net
yahoo.com<p>pop.mail.yahoo.com<s>smtp.mail.yahoo.com
yahoo.com.cn<p>pop.mail.yahoo.com.cn<s>smtp.mail.yahoo.com.cn
yahoo.com.tw<p>pop.mail.yahoo.com.tw<s>smtp.mail.yahoo.com.tw
public.guangzhou.gd.cn<p>smtp.public.guangzhou.gd.cn<s>public.guangzhou.gd.cn
bodachina.com<p>bodachina.com<s>smtp.bodachina.com
freemail.nx.cninfo.net<p>freemail.nx.cninfo.net<s>freemail.nx.cninfo.net
softhome.net<p>pop.SoftHome.net<s>smtp.SoftHome.net
yesky.com<p>pop.yesky.com<s>smtp.yesky.com
alibaba.com<p>pop.alibaba.com<s>smtp.alibaba.com
mweb.com.cn<p>pop3.mweb.com.cn<s>smtp.mweb.com.cn
51.com<p>210.77.145.189<s>
km169.net<p>email.km169.net<s>email.km169.net
wocall.com<p>wocall.com<s>wocall.com
guohao.com<p>guohao.com<s>guohao.com
bjmail.net<p>bjmail.net<s>bjmail.net
gzpublic.guangzhou.gd.cn<p>gzpublic.guangzhou.gd.cn<s>gzpublic.guangzhou.gd.cn
cnuninet.com<p>pop.bj.cnuninet.com<s>smtp.bj.cnuninet.com
cmmail.com<p>pop3.cmmail.com<s>smtp.cmmail.com

调用
procedure TForm1.Button3Click(Sender: TObject);
begin
SendMails(edit1.Text,edit2.Text,edit3.Text,memo1.Lines);
end;
 
1.解决163不能发信
从C:/Program Files/Borland/Delphi7/Source/Indy目录中找到IdSMTP.pas
将SendCmd('RSET'); 注释掉,重新编译,然后覆盖
1.1 C:/Program Files/Borland/Delphi7/Source/Indy中的IdSMTP.pas
1.2 C:/Program Files/Borland/Delphi7/Lib中的IdSMTP.dcu
1.3 C:/Program Files/Borland/Delphi7/Lib/Debug中的IdSMTP.dcu

2.解决用POP3收信时TITLE不能显示中文。
从C:/Program Files/Borland/Delphi7/Source/Indy目录中找到IdCoderHeader.pas
把 encodingstartpos:=PosStartAt('=?ISO', UpperCase(Header),1);
改成:encodingstartpos:=PosStartAt('=?', UpperCase(Header),1);
把 encodingstartpos:=PosStartAt('=?ISO', UpperCase(Header),encodingstartpos+1);
改成:encodingstartpos:=PosStartAt('=?', UpperCase(Header),encodingstartpos+1);
然后覆盖
1.1 C:/Program Files/Borland/Delphi7/Source/Indy中的IdCoderHeader.pas
1.2 C:/Program Files/Borland/Delphi7/Lib中的IdCoderHeader.dcu
1.3 C:/Program Files/Borland/Delphi7/Lib/Debug中的IdCoderHeader.dcu
 
*******IdPop3*********
邮件的数目:CheckMessages
邮件标题 :RetrieveHeader
接收邮件 :Retrieve

*******IdSMTP*********
发送邮件 :Send
为邮件添加自己的程序名称,即在邮件的头信息当中显示是由什么软件发出的邮件
IdSMTP.MailAgent := '你的邮件程序名称 或是签名信息'
 
http://www.nldelphi.com/forum/showthread.php?t=17682
看看这文章,会有帮助的。
 
换了个控件解决了。
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部