谁有SMTP发送邮件的组件代码？(100分)

谁有SMTP发送邮件的组件代码？用于ASP页面，要求能发送附件的Delphi代码！
谢谢！

SMTP.clearparams:=true;
SMTP.host:=IpAddr;
Smtp.TimeOut := 3000;
SMTP.port:=25;
Try
wait:=TWait.create(self);
wait.show;
wait.Refresh;
SMTP.Connect;
subject:=zch+'-'+YearV;
smtp.PostMessage.fromaddress:=FromAddr;
smtp.PostMessage.ToAddress.Add(ToAddr);
smtp.PostMessage.Attachments.Add(Path+'njdata.dat');
smtp.PostMessage.Subject:=StringCrypt('hg-keeper',Subject)
//注意返回值pchar
if Smtp.Connected then
SMTP.SendMail;

To:Yujx,怎么加附件呢？附件可是在本地计算机上啊，还有你使用的是ICS吗？
希望你的回答，谢谢！

ICS:使用 TSyncSmtpCli 控件

SyncSmtpCli1.Host:=smtp服务器;
SyncSmtpCli1.Port:='25';
SyncSmtpCli1.FromName:=发件人;
SyncSmtpCli1.RcptName.Text:=收信人;
SyncSmtpCli1.HdrTo=收信人;
SyncSmtpCli1.HdrSubject:=标题;
SyncSmtpCli1.EmailFiles.Add(附件文件名1);
SyncSmtpCli1.EmailFiles.Add(附件文件名2);
if(SyncSmtpCli1.ConnectSync())then
if(SyncSmtpCli1.HeloSync())then
SyncSmtpCli1.MailSync();

在ASP中能用吗？

asp的话你去下载jmail组件吧！到处都有下载。

哦，你要在asp上用？那你提ics干嘛
唉，你做成active server object给asp调用也行

To:ALL 可是没有源代码啊！那位给我个例子，我对ASP编程不熟悉。

如果是delphi的我有，刚发布了一个程序，发邮件，带附件都行，indy 控件的smtp
经过上万人验证了，很稳定，但ASP。。。我不会

巨简单，不过要求该站点支持SMTP服务.

<%
tOS=Request("Text_1")
tSoft=Request("Text_2")
tEmail=Request("Text_3")

Set FMail=Server.CreateObject("CDONTS.NewMail")
FMail.To="to@AAA.com"
FMail.From=tEmail
FMail.Subject="AAA"
FMail.Body="AAA"
FMail.Send
%>

我使用ICS的SMTPCLI，但是在DLL中，SMTPCLI就连最基本的连接都不行。怎么办？
Unit SendMailUnit;

Interface

Uses
ComObj, ActiveX, AspTlb, WinMail_TLB, StdVcl,
Globe, classes, Sysutils, SmtpProt;

Type
TSendMail = Class(TASPObject, ISendMail)
private
Smtp: TSmtpCli;
FHost: String;
FPort: integer;
FStatus: String;
FAttachFile: String;
FBodyText: String;
FBodyType: integer;
FAuthType: integer;
FCharSet: String;
FMailFrom: String;
FMailTo: String;
FMailCc: String;
FMailBcc: String;
FSubject: String;
FSender: String;
FVersion: String;
FMailToName: String;

FRecipient: TStrings
//邮件的接收人
FRecipientName: TStrings
//邮件接收人的名称
FMailCCs: TStrings
//抄送的接收人
FMailCCsName: TStrings
//抄送的接收人姓名
FAttachFiles: TStrings
//附件的文件名称

Procedure InitAll;
Procedure FreeAll;
Procedure ClearAll;
Procedure SendNow;
//SMTP Client的事件
Procedure SmtpDisplay(Sender: TObject
Msg: String);
Procedure SmtpProcessHeader(Sender: TObject
HdrLines: TStrings);
Procedure SmtpRequestDone(Sender: TObject
RqType: TSmtpRequest
Error:
Word);
//SMTP Client的事件
protected
Procedure OnEndPage
safecall;
Procedure OnStartPage(Const AScriptingContext: IUnknown)
safecall;
Function Get_Host: WideString
safecall;
Function Get_Port: Integer
safecall;
Function Get_Status: WideString
safecall;
Procedure Set_AttachFile(Const Value: WideString)
safecall;
Procedure Set_AuthType(Value: Integer)
safecall;
Procedure Set_BodyText(Const Value: WideString)
safecall;
Procedure Set_BodyType(Value: Integer)
safecall;
Procedure Set_Host(Const Value: WideString)
safecall;
Procedure Set_Port(Value: Integer)
safecall;
Procedure Set_CharSet(Const Value: WideString)
safecall;
Procedure Set_MailBcc(Const Value: WideString)
safecall;
Procedure Set_MailCc(Const Value: WideString)
safecall;
Procedure Set_MailFrom(Const Value: WideString)
safecall;
Procedure Set_MailTo(Const Value: WideString)
safecall;
Procedure Set_Sender(Const Value: WideString)
safecall;
Procedure Set_Subject(Const Value: WideString)
safecall;
Function Get_Version: WideString
safecall;
Procedure Send
safecall;
Procedure Set_MailToName(Const Value: WideString)
safecall;
Procedure Clear
safecall;
Function Get_SendIt: Integer
safecall;
End;

Implementation

Uses ComServ;

Procedure TSendMail.OnEndPage;
Begin
FreeAll;
Inherited OnEndPage;
End;

Procedure TSendMail.OnStartPage(Const AScriptingContext: IUnknown);
Begin
Inherited OnStartPage(AScriptingContext);
InitAll;
End;

Procedure TSendMail.InitAll;
Begin
Smtp := TSmtpCli.Create(Nil);
With Smtp Do
Begin
OnDisplay := SmtpDisplay;
OnRequestDone := SmtpRequestDone;
OnProcessHeader := SmtpProcessHeader;
End;

FRecipient := TStringList.Create
//邮件的接收人
FRecipientName := TStringList.Create
//邮件接收人的名称
FMailCCs := TStringList.Create
//抄送的接收人
FMailCCsName := TStringList.Create
//抄送的接收人姓名
FAttachFiles := TStringList.Create
//附件的文件名称
FPort := 25;
FStatus := '系统初始化';
End;

Procedure TSendMail.FreeAll;
Begin
FRecipient.Free
//邮件的接收人
FRecipientName.Free
//邮件接收人的名称
FMailCCs.Free
//抄送的接收人
FMailCCsName.Free
//抄送的接收人姓名
FAttachFiles.Free
//附件的文件名称

Try
Smtp.Abort;
Smtp.Free;
Except
End;
End;

Procedure TSendMail.ClearAll;
Begin
FAttachFile := '';
FBodyText := '';
FBodyType := 0;
FAuthType := 0;
FCharSet := 'iso-8859-1';
FMailFrom := '';
FMailTo := '';
FMailCc := '';
FMailBcc := '';
FSubject := '';
FSender := '';
FVersion := '';
FMailToName := '';
FPort := 25;

If FRecipient <> Nil Then
FRecipient.Clear;

If FRecipientName <> Nil Then
FRecipientName.Clear;

If FMailCCs <> Nil Then
FMailCCs.Clear;

If FMailCCsName <> Nil Then
FMailCCsName.Clear;

If FAttachFiles <> Nil Then
FAttachFiles.Clear;

End;

Procedure TSendMail.SendNow;
Begin
If Smtp <> Nil Then
Begin
If FBodyType = 1 Then
smtp.ContentType := smtpHTML
Else
smtp.ContentType := smtpPlainText;

smtp.FromName := FMailFrom;
smtp.HdrFrom := FMailTo;
smtp.SignOn := FMailFrom;
smtp.Host := FHost;
smtp.Port := IntToStr(FPort);
smtp.MailMessage.Add(FBodyText);
smtp.EmailFiles.Clear;
// smtp.EmailFiles.Add('c:/PDOXUSRS.NET');
If FAuthType = 0 Then
smtp.AuthType := smtpAuthNone
Else
smtp.AuthType := smtpAuthLogin;

smtp.Open;
FStatus := FStatus + #13 + #10 + '连接到SMTP服务器:' + FHost + ' port:' + smtp.Port;
If smtp.Connected Then
FStatus := FStatus + #13 + #10 + ' connected'
Else
FStatus := FStatus + #13 + #10 + ' disconnected';
End
Else
Begin
FStatus := FStatus + #13 + #10 + '未建立SMTP客户端';
End;
End;

//SMTP Client的事件

Procedure TSendMail.SmtpDisplay(Sender: TObject
Msg: String);
Begin
FStatus := Msg;
FStatus := FStatus + #13 + #10 + ' SmtpDisplay';
End;

Procedure TSendMail.SmtpProcessHeader(Sender: TObject
HdrLines: TStrings);
Begin
// HdrLines.Add('cc: ' + FMailCc);
FStatus := FStatus + #13 + #10 + ' SmtpProcessHeader';
End;

Procedure TSendMail.SmtpRequestDone(Sender: TObject
RqType: TSmtpRequest;
Error: Word);
Begin
FStatus := FStatus + #13 + #10 + ' SmtpRequestDone';
If (error = 0) Then
Begin
Case RqType Of
smtpOpen:
Begin
smtp.RcptName.Clear;
smtp.RcptName.Add(FMailTo);
smtp.HdrTo := FMailTo;
smtp.HdrSubject := FSubject;
smtp.Mail;
FStatus := FStatus + #13 + #10 + 'SMTP Open';
End;
smtpMail:
Begin
smtp.Quit;
FStatus := FStatus + #13 + #10 + 'SMTP Mail';
End;
smtpQuit:
Begin
FStatus := FStatus + #13 + #10 + 'SMTP Quit';
End;
Else
FStatus := FStatus + #13 + #10 + 'SMTP Err1';
End
{ case }
End
Else
FStatus := FStatus + #13 + #10 + 'SMTP Err2';
End;
//SMTP Client的事件

//-----------------------------------------------------------------------------

Function TSendMail.Get_Host: WideString;
Begin
Result := FHost;
End;

Function TSendMail.Get_Port: Integer;
Begin
Result := FPort;
End;

Function TSendMail.Get_Status: WideString;
Begin
Result := FStatus;
End;

Procedure TSendMail.Set_AttachFile(Const Value: WideString);
Begin
If FAttachFiles = Nil Then
FAttachFiles := TStringList.Create;
FAttachFiles.Add(Value);
End;

Procedure TSendMail.Set_AuthType(Value: Integer);
Begin
FAuthType := Value;
End;

Procedure TSendMail.Set_BodyText(Const Value: WideString);
Begin
FBodyText := Value;
End;

Procedure TSendMail.Set_BodyType(Value: Integer);
Begin
FBodyType := Value;
End;

Procedure TSendMail.Set_Host(Const Value: WideString);
Begin
FHost := Value;
End;

Procedure TSendMail.Set_Port(Value: Integer);
Begin
FPort := Value;
End;

Procedure TSendMail.Set_CharSet(Const Value: WideString);
Begin
FCharSet := Value;
End;

Procedure TSendMail.Set_MailBcc(Const Value: WideString);
Begin
FMailBcc := Value;
End;

Procedure TSendMail.Set_MailCc(Const Value: WideString);
Begin
FMailCc := Value;
End;

Procedure TSendMail.Set_MailFrom(Const Value: WideString);
Begin
FMailFrom := Value;
End;

Procedure TSendMail.Set_MailTo(Const Value: WideString);
Begin
FMailTo := Value;
End;

Procedure TSendMail.Set_Sender(Const Value: WideString);
Begin
FSender := Value;
End;

Procedure TSendMail.Set_Subject(Const Value: WideString);
Begin
FSubject := Value;
End;

Function TSendMail.Get_Version: WideString;
Begin
Result := FVersion;
End;

Procedure TSendMail.Send;
Begin
SendNow;

End;

Procedure TSendMail.Set_MailToName(Const Value: WideString);
Begin
FMailToName := Value;
End;

Procedure TSendMail.Clear;
Begin
ClearAll;
End;

Function TSendMail.Get_SendIt: Integer;
Begin
SendNow;
End;

Initialization
TAutoObjectFactory.Create(ComServer, TSendMail, Class_SendMail,
ciMultiInstance, tmApartment);
End.
-----------------
有什么问题吗？
请教！

给了代码。怎么没有人知道为什么啊。是不是在DLL中不能动态生成构件。
[]

[][!]

INDY中怎么加附件啊?

toipi
我按你的方法设置，怎么收不到邮件呢？

To 鼻涕虫
我现在也要用DELPHI写一个群发软件带附件的，能不能发给我看看
zhysop@163.com