indy9 的smtp server发出去的邮件 ,我的信箱为什么收不到?(100分)

  • 主题发起人 主题发起人 chenggn
  • 开始时间 开始时间
C

chenggn

Unregistered / Unconfirmed
GUEST, unregistred user!
{-----------------------------------------------------------------------------
Demo Name: SMTPRelay
Author: Allen O'Neill - Springboard Technologies Ltd - http://www.springboardtechnologies.com
Copyright: Indy Pit Crew
Purpose:
History:
Date: 27/10/2002 00:27:55
Checked with Indy version: 9.0 - Allen O'Neill - Springboard Technologies Ltd - http://www.springboardtechnologies.com
-----------------------------------------------------------------------------
Notes:

Demonstrates sending an email without the use of a local SMTP server
This works by extracting the domain part form the recipient email address,
then doing an MX lookup against a DNS server for that domain part,
and finally connecting directly to the SMTP server that the MX record
point to, to deliver the message.

}


unit fMain;

interface

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

type
TfrmMain = class(TForm)
IdMessage: TIdMessage;
IdDNSResolver: TIdDNSResolver;
IdSMTP: TIdSMTP;
Label1: TLabel;
sbMain: TStatusBar;
Label2: TLabel;
edtDNS: TEdit;
Label3: TLabel;
Label4: TLabel;
edtSender: TEdit;
Label5: TLabel;
edtRecipient: TEdit;
Label6: TLabel;
edtSubject: TEdit;
Label7: TLabel;
mmoMessageText: TMemo;
btnSendMail: TButton;
btnExit: TButton;
IdAntiFreeze: TIdAntiFreeze;
Label8: TLabel;
edtTimeOut: TEdit;
Label9: TLabel;
Label10: TLabel;
procedure btnExitClick(Sender: TObject);
procedure btnSendMailClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
fMailServers : TStringList;
Function PadZero(s:String):String;
Function GetMailServers:Boolean;
Function ValidData : Boolean;
Procedure SendMail; OverLoad;
Function SendMail(aHost : String):Boolean; OverLoad;
Procedure LockControls;
procedure UnlockControls;
Procedure Msg(aMessage:String);
end;

var
frmMain: TfrmMain;

implementation

{$R *.DFM}


procedure TfrmMain.btnExitClick(Sender: TObject);
begin
application.terminate;
end;

procedure TfrmMain.btnSendMailClick(Sender: TObject);
begin
Msg('');
LockControls;
if ValidData then SendMail;
UnlockControls;
Msg('');
end;

function TfrmMain.GetMailServers: Boolean;
var
i,x : integer;
LDomainPart : String;
LMXRecord : TMXRecord;
begin
if not assigned(fmailServers) then fMailServers := TStringList.Create;
fmailServers.clear;

Result := true;
with IdDNSResolver do
begin
QueryResult.Clear;
QueryRecords := [qtMX];
Msg('Setting up DNS query parameters');
Host := edtDNS.text;
ReceiveTimeout := StrToInt(edtTimeOut.text);
// Extract the domain part from recipient email address
LDomainPart := copy(edtRecipient.text,pos('@',edtRecipient.text)+1,length(edtRecipient.text)); // the domain name to resolve

try
Msg('Resolving DNS');
Resolve(LDomainPart);

if QueryResult.Count > 0 then
begin
for i := 0 to QueryResult.Count - 1 do
begin
LMXRecord := TMXRecord(QueryResult.Items);
fMailServers.Append(PadZero(IntToStr(LMXRecord.Preference)) + '=' + LMXRecord.ExchangeServer);
end;

// sort in order of priority and then remove extra data
fMailServers.Sorted := false;
for i := 0 to fMailServers.count - 1 do
begin
x := pos('=',fMailServers.Strings);
if x > 0 then fMailServers.Strings :=
copy(fMailServers.Strings,x+1,length(fMailServers.Strings));
end;
fMailServers.Sorted := true;
fMailServers.Duplicates := dupIgnore;
Result := true;
end
else
begin
Msg('No response from DNS server');
MessageDlg('There is no response from the DNS server !', mtInformation, [mbOK], 0);
Result := false;
end;
except
on E : Exception do
begin
Msg('Error resolving domain');
MessageDlg('Error resolving domain: ' + e.message, mtInformation, [mbOK], 0);
Result := false;
end;
end;

end;
end;

// Used in DNS preferance sorting
procedure TfrmMain.LockControls;
var i : integer;
begin
edtDNS.enabled := false;
edtSender.enabled := false;
edtRecipient.enabled := false;
edtSubject.enabled := false;
mmoMessageText.enabled := false;
btnExit.enabled := false;
btnSendMail.enabled := false;
end;

procedure TfrmMain.UnlockControls;
begin
edtDNS.enabled := true;
edtSender.enabled := true;
edtRecipient.enabled := true;
edtSubject.enabled := true;
mmoMessageText.enabled := true;
btnExit.enabled := true;
btnSendMail.enabled := true;
end;


function TfrmMain.PadZero(s: String): String;
begin
if length(s) < 2 then
s := '0' + s;
Result := s;
end;

procedure TfrmMain.SendMail;
var
i : integer;
begin
if GetMailServers then
begin
with IdMessage do
begin
Msg('Assigning mail message properties');
From.Text := edtSender.text;
Sender.Text := edtSender.text;
Recipients.EMailAddresses := edtRecipient.text;
Subject := edtSubject.text;
Body := mmoMessageText.Lines;
end;

for i := 0 to fMailServers.count -1 do
begin
Msg('Attempting to send mail');
if SendMail(fMailServers.Strings) then
begin
MessageDlg('Mail successfully sent and available for pickup by recipient !', mtInformation, [mbOK], 0);
Exit;
end;
end;
// if we are here then something went wrong .. ie there were no available servers to accept our mail!
MessageDlg('Could not send mail to remote server - please try again later.', mtInformation, [mbOK], 0);
end;
if assigned(fMailServers) then FreeAndNil(fMailServers);
end;

function TfrmMain.SendMail(aHost: String): Boolean;
begin
Result := false;
with IdSMTP do
begin
Caption := 'Trying to sendmail via: ' + aHost;
Msg('Trying to sendmail via: ' + aHost);
Host := aHost;
try
Msg('Attempting connect');
Connect;
Msg('Successful connect ... sending message');
Send(IdMessage);
Msg('Attempting disconnect');
Disconnect;
msg('Successful disconnect');
Result := true;
except on E : Exception do
begin
if connected then try disconnect; except end;
Msg('Error sending message');
result := false;
ShowMessage(E.Message);
end;
end;
end;
Caption := '';
end;


function TfrmMain.ValidData: Boolean;
var ErrString:string;
begin
Result := True;
ErrString := '';

if trim(edtDNS.text) = '' then ErrString := ErrString + #13 + #187 + 'DNS server not filled in';
if trim(edtSender.text) = '' then ErrString := ErrString + #13 + #187 + 'Sender email not filled in';
if trim(edtRecipient.text) = '' then ErrString := ErrString + #13 + #187 + 'Recipient not filled in';

if ErrString <> '' then
begin
MessageDlg('Cannot proceed due to the following errors:'+#13+#10+ ErrString, mtInformation, [mbOK], 0);
Result := False;
end;
end;

procedure TfrmMain.Msg(aMessage: String);
begin
sbMain.SimpleText := aMessage;
application.ProcessMessages;
end;

end.

 
可能服务器要效验用户密码吧, 看看IndyDemos中的MailClient吧[:)]
 
知道了
首先,我说的SMTP SERVER, 服务段
1,indy9 的例子本来就不能运行,他的注释中写了。
2,看了很多帖子都是直接邮,我现在的做法是用 SMTP 从客户端读取信件,然后用直接邮的方法发到 目的地。不知道这样是正统的最法么?
直接邮的方式可以发送附件么?抄送,转发呢?
 
不会吧?我才做过了测试成功了才写了上面那句话的,这是MailClient的说明:
{-----------------------------------------------------------------------------
Demo Name: Main
Author: Hadi Hariri <hadi@hadihariri.com>
Copyright: Indy Pit Crew
Purpose:
History:
Date: 27/10/2002 01:12:37
Checked with Indy version: 9.0 - Allen O'Neill - Springboard Technologies Ltd - http://www.springboardtechnologies.com
-----------------------------------------------------------------------------
Notes:

Demonstrates basic email component usage

}
 
SMTPRelay这个Demo没有发送验证的内容,你自己加上就OK了,我前面说了服务器要效验用户密码的
 
不能直接发送,比如
someone@somewhere.com不能直接连接到smtp.somewhere.com上,因为即有可能是ESMTP的服务器,也就是需要验证密码的,从而不能发送到对方的邮箱中。
你需要的是通过DNS查找MX(mail exchange server)邮件交换服务器,从而得到对方接收邮件的MX服务器地址,然后才能发送.
可以看看下面的说明
http://www.blogbus.com/blogbus/blog/diary.php?diaryid=189387
 
后退
顶部