谁能给我一个发邮件(带附件的)程序(300分)

  • 主题发起人 jiangzhang3942
  • 开始时间
J

jiangzhang3942

Unregistered / Unconfirmed
GUEST, unregistred user!
如题,谁能给我一个发邮件(带附件的)程序,以前写的一个用了很久但是不知道最近为什么不行了,以下是源程序:
unit SendEmail;


interface
uses windows, IdBaseComponent, IdMessage, IdComponent,IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,Classes;
function MySendEmail : boolean;
procedure init(MyUserEmail,MySmtpServerUser,MySmtpServerPassword,MySmtpServerName,
MyFromText,MySSubject,MySFuJian : string;MySBody : Tstrings);
var
IdMsgSend : TIdMessage;
SMTP : TIdSMTP;
SBody : Tstrings;//内容
UserEmail:string;//收件人邮件地址
SmtpAuthType:integer;//验证
SmtpServerUser:string;//登陆SMTP服务器的用户名
SmtpServerPassword:string;//登陆SMTP服务器用到的密码
SmtpServerName:string;//SMTP服务器名.例如:smtp.sohu.com
SmtpServerPort:integer;//SMTP服务器端口,默认的是25
FromText : string;//发件人地址
SSubject : string;//邮件主体/
SFuJian : string;//附件路径
implementation
function MySendEmail : boolean;
begin
result := false;
with IdMsgSend do
begin
Body.Assign(SBody); //需要赋值?????????
From.Text := FromText; //发件人 需要赋值?????????
ReplyTo.EMailAddresses :=UserEmail ;
Recipients.EMailAddresses :=UserEmail; { To: header }//收件人地址
Subject := SSubject; { Subject: header } //邮件主体
ReceiptRecipient.Text := '';
end;
case SmtpAuthType of
0: SMTP.AuthenticationType := atNone;
1: SMTP.AuthenticationType := atLogin; {Simple Login }
end;
SMTP.Userid := SmtpServerUser;
SMTP.Password := SmtpServerPassword;
TIdAttachment.Create(IdMsgSend.MessageParts, SFuJian);//添加附件 需要赋值?????????
SMTP.Host := SmtpServerName;
SMTP.Port := SmtpServerPort;
SMTP.Connect;
try
SMTP.Send(IdMsgSend);
result := true;
finally
SMTP.Disconnect;
end;
end;
procedure init(MyUserEmail,MySmtpServerUser,MySmtpServerPassword,MySmtpServerName,
MyFromText,MySSubject,MySFuJian : string;MySBody : Tstrings);
begin
UserEmail := MyUserEmail; //收件人邮件地址
SmtpAuthType := 1; //验证
SmtpServerUser := MySmtpServerUser;//登陆SMTP服务器的用户名
SmtpServerPassword := MySmtpServerPassword; //登陆SMTP服务器用到的密码
SmtpServerName := MySmtpServerName; //SMTP服务器名.例如:smtp.sohu.com
SmtpServerPort := 25; //SMTP服务器端口,默认的是25 }
FromText := MyFromText;//发件人
SSubject := MySSubject;//邮件主题
SFuJian := MySFuJian;//附件地址
SBody := MySBody;//邮件内容
end;
initialization
IdMsgSend := TIdMessage.Create(nil);
SMTP := TIdSMTP.Create(nil);
SBody := Tstringlist.Create;
finalization
IdMsgSend.Free;
SMTP.Free;
// SBody.Free;
end.

谁有比较好的一个能给我一份吗?
 
unit UntMail;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, te_controls, ksthemepanels, ExtCtrls, StdCtrls,
ksthemestdcontrol, ksthemebuttons, ksthemeedits, ksthemelabels,
IdMessage, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP;

type
TFrmMain = class(TForm)
TeThemePanel1: TTeThemePanel;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Splitter1: TSplitter;
TeThemeLabel1: TTeThemeLabel;
edtSmtpSvr: TTeThemeEdit;
EdtFRom: TTeThemeEdit;
EdtTo: TTeThemeEdit;
ledSubject: TTeThemeEdit;
ledAttachment: TTeThemeEdit;
TeThemeButton1: TTeThemeButton;
BtnSendMail: TTeThemeButton;
BodyMemo: TTeThemeMemo;
TeThemeLabel2: TTeThemeLabel;
TeThemeLabel3: TTeThemeLabel;
StatusMemo: TTeThemeMemo;
TeThemeLabel4: TTeThemeLabel;
TeThemeLabel5: TTeThemeLabel;
IdSMTP1: TIdSMTP;
SMTP: TIdSMTP;
MailMessage: TIdMessage;
AttachmentDialog: TOpenDialog;
TeThemeLabel6: TTeThemeLabel;
EdtUsername: TTeThemeEdit;
TeThemeLabel7: TTeThemeLabel;
EdtPassword: TTeThemeEdit;
procedure TeThemeButton1Click(Sender: TObject);
procedure BtnSendMailClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FrmMain: TFrmMain;
FileName:String;
implementation

{$R *.dfm}

procedure TFrmMain.TeThemeButton1Click(Sender: TObject);
begin
if AttachmentDialog.Execute then
begin
FileName:=AttachmentDialog.FileName;
ledAttachment.Text:=FileName;
end else begin
ledAttachment.Clear;
ShowMessage('添加附件失败!');
end;
end;

procedure TFrmMain.BtnSendMailClick(Sender: TObject);
begin
StatusMemo.Clear;
//设置SMTP
SMTP.Host := edtSmtpSvr.Text; //具体使用的SMTP,可以到你申请的邮箱所在的网站中去找
SMTP.AuthenticationType:=atLogin;
SMTP.Username :=EdtUsername.Text;
SMTP.Password := EdtPassword.Text;
SMTP.Port := 25;
//设置邮件内容
MailMessage.From.Address := EdtFrom.Text;
MailMessage.Recipients.EMailAddresses := EdtTo.Text ;//+ ',' + ledCC.Text;

MailMessage.Subject := ledSubject.Text;
MailMessage.Body.Text := BodyMemo.Text;

if FileExists(ledAttachment.Text) then
TIdAttachment.Create(MailMessage.MessageParts,
ledAttachment.Text);//发送邮件
try
try
SMTP.Connect(1000);
SMTP.Authenticate;
SMTP.Send(MailMessage);
StatusMemo.Lines.Clear;
StatusMemo.Lines.Add('邮件:'+EdtTo.Text+'成功发送!!!');
except on E:Exception do
StatusMemo.Lines.Insert(0, 'ERROR: ' + E.Message);
end;
finally
if SMTP.Connected then
SMTP.Disconnect;
end;

end;

end.
 
好像不行呀
 
以下是我正在使用的一只程序。可以正常发邮件。如果不能发,请检查一下防火墙,有可以是防火墙挡住了。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdMessageClient, IdNNTP, IdSMTP, IdMessage, inifiles,
ExtCtrls, DateUtils;

type
TForm1 = class(TForm)
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function writelog(const logstr: string): integer;
var
logFilestr: textfile;
FileHandle: thandle;
begin
try
if not FileExists('c:/errorlog.log') then
begin
FileHandle := filecreate('c:/errorlog.log');
FileClose(FileHandle);
end;
AssignFile(logFilestr, 'c:/errorlog.log');
Reset(logFilestr);
if FileSize(logfilestr) > 1000 * 8 then begin
closefile(logfilestr);
deletefile('c:/errorlog.log');
FileHandle := filecreate('c:/errorlog.log');
FileClose(FileHandle);
AssignFile(logFilestr, 'c:/errorlog.log');
end;
append(logFilestr);
WriteLn(logFilestr, logstr);
//WriteLn(logFilestr, '');
Closefile(logFilestr);
finally

end;
result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
IniFile: TIniFile;
FileHandle: Thandle;
Filedate: TDateTime;
begin
label1.Caption := 'Start at ' + datetimetostr(now());
IniFile := TIniFile.Create('./mailer.ini');
if inifile.ReadString('mailhead', 'checkfiledate', '') = '1' then
begin
if fileexists(inifile.ReadString('mailhead', 'Attachment', '')) then
begin
FileHandle := FileOpen(inifile.ReadString('mailhead', 'Attachment', ''), fmOpenRead);
FileDate := FileDateToDateTime(FileGetDate(FileHandle));
FileClose(filehandle);
if dateof(filedate) <> dateof(now()) then begin
writelog(DateTimeToStr(now) + #9+ 'Today has no Error.');
Application.Terminate;
Exit;
end;
end
else begin
writelog(DateTimeToStr(now) + #9+ 'No Errorlogfile.');
Application.Terminate;
exit;
end;

end;

idsmtp1.Host := inifile.ReadString('mailserver', 'host', '');
idsmtp1.Username := inifile.ReadString('mailserver', 'username', '');
idsmtp1.Password := inifile.ReadString('mailserver', 'password', '');
idsmtp1.AuthenticationType := atLogin;
idmessage1.From.Text := inifile.ReadString('mailhead', 'from', '');
idmessage1.Recipients.EMailAddresses := inifile.ReadString('mailhead', 'Recipients', '');
idmessage1.Subject := inifile.ReadString('mailhead', 'subject', '');
idmessage1.Body.text := 'See the attachment. --' + datetimetostr(now());
if fileexists(inifile.ReadString('mailhead', 'Attachment', '')) then
TIdAttachment.Create(idMessage1.MessageParts, inifile.ReadString('mailhead', 'Attachment', ''));
if fileexists(inifile.ReadString('mailhead', 'Attachment1', '')) then
TIdAttachment.Create(idMessage1.MessageParts, inifile.ReadString('mailhead', 'Attachment1', ''));
if fileexists(inifile.ReadString('mailhead', 'Attachment2', '')) then
TIdAttachment.Create(idMessage1.MessageParts, inifile.ReadString('mailhead', 'Attachment2', ''));
if fileexists(inifile.ReadString('mailhead', 'Attachment3', '')) then
TIdAttachment.Create(idMessage1.MessageParts, inifile.ReadString('mailhead', 'Attachment3', ''));
try
idsmtp1.Connect;
except
begin
// showmessage('connect error');
writelog(DateTimeToStr(now) + #9+'Can not connect host' + idsmtp1.Host);
Application.Terminate;
exit;
end;
end;
//if SMTP1.Connected() then
// begin
try
idsmtp1.Send(idmessage1);
except
// showmessage('send fail');
writelog(DateTimeToStr(now) + #9+ 'Send failed.');
Application.Terminate;
Exit;
end;
writelog(DateTimeToStr(now) + #9+'Send OK.');
Application.Terminate;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Close;
end;

end.
 

Similar threads

顶部