高难度!!!!!高手的试金石!!!!!重点关注,SMTP高手!!!!!!!!(100分)

J

jzmin

Unregistered / Unconfirmed
GUEST, unregistred user!
问题:我用IDSMTP控件做了一个发邮件的软件,能否在发每一封邮件时,能
用进度条显示每一封信发送进度。
基本思路:正文文件长度+附件文件长度
能否写出具体思路,和具体语句!!!!!!!!!
谢谢!!!!!!!!!!!!!!!!
 
var imailcount:integer;

procedure TMailSender.IdSMTP1WorkBegin(Sender: TObject;
AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
imailcount:=AWorkCountMax ;
end;

procedure TMailSender.IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
lable1.caption:=formatfloat('0.00%',AWorkCount/imailcount);
end;
 
呵呵,感觉IdSMTP这个控件不是很好.
看我用socket通过ESMTP服务器发邮件的一个函数
{
socket通过ESMTP服务器发邮件的一个函数
by ruder
email:cocoruder@163.com
http://www.stuinfo.com
更多关于smtp扩展及mime格式请参考rfc文档等
程序在smtp.163.com上测试通过!
enjoy it!
}

type
tomail=array [0..49] of string;

var
function makeemailfile(frommail,tomail,subject,body,attfile:string;haveatt:bool):bool; //make body function

procedure sendmail(smtpip,user,pass,frommail,subject,body,attfile:string;tomail:Taddress;haveatt:bool;needAuth:bool);
{haveatt--有无附件,needAuth--需不需要验证,tomail--收件人地址}
const
HELO='HELO';
MAILFROM='MAIL FROM';
RCPTTO='RCPT TO';
DATA='DATA';
AUTHLOGIN='AUTH LOGIN';
QUIT='QUIT';
ENDSIGN=#13#10'.'#13#10;
var
wsa:TwsaData;
s:Tsocket;
server:Tsockaddr;
sendbuffer,recvbuffer:array [0..1023] of char;
error:integer;
sendstr:string;
f:file;
bodybuffer:array of char;
fsize,ii:integer;

begin
try
Wsastartup($0101,wsa); //start socket lib
s:=socket(AF_INET,SOCK_STREAM,0); //start socket
if s=invalid_socket then exit;

server.sin_family:=af_inet;
server.sin_port:=htons(25);
server.sin_addr.S_addr:=inet_addr(pchar(smtpip));
error:=connect(s,server,sizeof(server)); //connect server
if error<>0 then exit;

recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),1)=false then begin
closesocket(s);
wsacleanup;
exit;
end; {showinfo检查服务器返回值的函数}

sendstr:=HELO+' test'+#13#10; //send Helo
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),2)=false then begin
closesocket(s);
wsacleanup;
exit;
end;

if needAuth then begin //需要验证?
Fillchar(sendbuffer,sizeof(sendbuffer),0);
sendstr:=AUTHLOGIN+#13#10; //send "AUTH LOGIN"
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),3)=false then begin
closesocket(s);
wsacleanup;
exit;
end;
Fillchar(sendbuffer,sizeof(sendbuffer),0);
sendstr:=Base64Encode(user)+#13#10; {send user,user需要Base64编码}
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),4)=false then begin
closesocket(s);
wsacleanup;
exit;
end;
Fillchar(sendbuffer,sizeof(sendbuffer),0);
sendstr:=Base64Encode(pass)+#13#10; {send pass,base64}
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),5)=false then begin
closesocket(s);
wsacleanup;
exit;
end;
end;

Fillchar(sendbuffer,sizeof(sendbuffer),0);
sendstr:=MAILFROM+':'+frommail+#13#10; //send "MAIL FROM:"
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),6)=false then begin
closesocket(s);
wsacleanup;
exit;
end;

ii:=0;
while (true) do begin
if (tomail[ii]='') then break;
Fillchar(sendbuffer,sizeof(sendbuffer),0);
sendstr:=RCPTTO+':'+tomail[ii]+#13#10; //send "RCPT TO:"
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),7)=false then begin
closesocket(s);
wsacleanup;
exit;
end;
inc(ii);
end;

Fillchar(sendbuffer,sizeof(sendbuffer),0);
sendstr:=DATA+#13#10; //send "DATA"
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),8)=false then begin
closesocket(s);
wsacleanup;
exit;
end;
{data start}

if makeemailfile(frommail,'my friend',subject,body,attfile,haveatt)=false then begin
shutdown(s,1);
exit;
end;

{makeemailfile 这个函数用来生成mime格式的body}

assignfile(f,fname);
reset(f,1);
fsize:=filesize(f);
setlength(bodybuffer,fsize);
blockread(f,bodybuffer[0],fsize);

closefile(f);


send(s,bodybuffer[0],length(bodybuffer),0);

sendstr:=ENDSIGN; //DATA over
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),9)=false then begin
closesocket(s);
wsacleanup;
exit;
end;

Fillchar(sendbuffer,sizeof(sendbuffer),0);
sendstr:=QUIT+#13#10; //bye
strpcopy(sendbuffer,sendstr);
send(s,sendbuffer,length(sendstr),0);
Fillchar(recvbuffer,sizeof(recvbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
if showinfo(strpas(recvbuffer),10)=false then begin
closesocket(s);
wsacleanup;
exit;
end;
emailform.Memo3.Lines.Add('send OK!');
closesocket(s);

WsaCleanUp;
except
end;

end;


function makeemailfile(frommail,tomail,subject,body,attfile:string;haveatt:bool):bool;
const
_Code64: String[64] =('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/');
crlf=#13#10;

var
boundarystr:string;
datastr,datastr1:string;
f:file;
buf1:array[0..2] of byte;
buf2:array[0..3] of char;
llen,len,pad,i:integer;
source:file;
buffer:array [0..5600] of char;
begin
result:=false;
try
boundarystr:=makeboundary; //随机生成标签

datastr:='From:'+frommail+#13#10
+'To:'+tomail+#13#10
+'Subject:'+subject+#13#10
+'MIME-Version: 1.0'+#13#10
+'Content-Type: multipart/mixed;boundary="'+boundarystr+'"'+#13#10+#13#10
+'This is a multi-part message in MIME format.'+#13#10+#13#10
+'--'+boundarystr+#13#10
+'Content-Type: multipart/alternative;boundary="'+boundarystr+'"'+#13#10+#13#10
+'--'+boundarystr+#13#10
+'Content-Type: text/plain;charset="gb2312"'+#13#10+#13#10
+body+#13#10+#13#10
+'--'+boundarystr+'--'+#13#10+#13#10;
if fileexists(fname) then
deletefile(fname);

assignfile(f,fname);
rewrite(f,1);
strpcopy(buffer,datastr);
blockwrite(f,buffer,length(datastr));


if haveatt=true then begin
datastr1:='--'+boundarystr+#13#10
+'Content-Type: application/x-msdownload;name="'+ExtractFileName(attfile)+'"'+#13#10
+'Content-Transfer-Encoding: base64'+#13#10
+'Content-Disposition: attachment;filename="'+ExtractFileName(attfile)+'"'+#13#10+#13#10;
strpcopy(buffer,datastr1);
blockwrite(f,buffer,length(datastr1));
assignfile(source,attfile);
reset(source,1);
pad:=0;
llen:=0;
while (1=1) do
begin
blockread(source,buf1,3,len);if len=0 then break;
if (len<3) then
begin
pad:=3-len;
for i:=len to 2 do
buf1:=0;
end;
buf2[0]:=_Code64[buf1[0] div 4+1];
buf2[1]:=_Code64[(buf1[0] mod 4)*16 + (buf1[1] div 16)+1];
buf2[2]:=_Code64[(buf1[1] mod 16)*4 + (buf1[2] div 64)+1];
buf2[3]:=_Code64[buf1[2] mod 64+1];
//这里进行了编码
if (pad<>0) then
begin
if pad=2 then buf2[2]:='=';
buf2[3]:='=';
//输入只有一个或两个字节,那么输出将用等号“=”补足
blockwrite(f,buf2,4);
end
else
begin
blockwrite(f,buf2,4);
end;
inc(llen,4);
if (llen=76) then
begin
blockwrite(f,crlf,2);
//控制每行只写76个字符
llen:=0;
end;
end;


closefile(source);
end;

closefile(f);
result:=true;
except
end;
end;
 
强烈,收藏.
 
接受答案了.
 

Similar threads

S
回复
0
查看
962
SUNSTONE的Delphi笔记
S
S
回复
0
查看
784
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
顶部