分享
 
 
 

TCP/IP(七)

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

(*@\\\0000000501*)

(*@/// procedure t_smtp.action; *)

procedure t_smtp.action;

var

i,j: integer;

s: string;

begin

if (f_receipts=NIL) or (f_receipts.count=0)

or (f_body=NIL) or (f_body.count=0) or (f_user='') then EXIT;

(* not all necessary data filled in *)

login;

f_host:=my_hostname;

(*@/// Open Connection and submit header data *)

self.response; (* Read the welcome message *)

self.SendCommand('HELO '+f_host); (* open connection *)

self.response;

if f_status_nr>=300 then

raise EProtocolError.Create('SMTP',f_status_txt,f_status_nr);

self.SendCommand('MAIL FROM: <'+address_from(f_user,1)+'>'); (* send header data *)

self.response;

if f_status_nr>=300 then

raise EProtocolError.Create('SMTP',f_status_txt,f_status_nr);

for i:=0 to f_receipts.count-1 do begin

j:=0;

while true do begin

inc(j);

s:=address_from(f_receipts.strings[i],j);

if s<>'' then begin

self.SendCommand('RCPT TO: <'+s+'>'); (* submit the receipts *)

self.response;

(* Log error users for later check ? *)

end

else BREAK;

end;

end;

self.SendCommand('DATA'); (* ready to send the mail *)

self.response;

if f_status_nr=354 then begin

for i:=0 to f_body.count-1 do begin

if f_body.strings[i]='.' then f_body.strings[i]:=',';

self.write_s(f_socket,f_body.strings[i]+#13#10);

end;

self.write_s(f_socket,'.'+#13#10);

self.response;

end;

if f_status_nr>=300 then

raise EProtocolError.Create('SMTP',f_status_txt,f_status_nr);

(*@\\\*)

end;

(*@\\\0000000A17*)

(*@/// procedure t_smtp.response; *)

procedure t_smtp.response;

var

s: string;

begin

s:=self.read_line(f_socket);

if assigned(f_tracer) then

f_tracer(s,tt_proto_get);

f_status_nr:=strtoint(copy(s,1,3));

f_status_txt:=copy(s,5,length(s));

(* if the answer consists of several lines read and discard all the following *)

while pos('-',s)=4 do begin

s:=self.read_line(f_socket);

if assigned(f_tracer) then

f_tracer(s,tt_proto_get);

end;

end;

(*@\\\0000000801*)

(*@/// procedure t_smtp.SetBody(Value: TStringList); *)

procedure t_smtp.SetBody(Value: TStringList);

begin

if value=NIL then

f_body.clear

else

f_body.assign(value);

end;

(*@\\\0000000603*)

(*@/// procedure t_smtp.SetRecipients(Value: TStringList); *)

procedure t_smtp.SetRecipients(Value: TStringList);

begin

if value=NIL then

f_receipts.clear

else

f_receipts.assign(value);

end;

(*@\\\0000000603*)

(*@\\\0000000401*)

(*@/// class t_pop3(t_tcpip) *)

type

(*@/// t_reply=class(TObject) *)

t_reply=class(TObject)

public

index: integer;

length: integer;

from: string;

subject: string;

end;

(*@\\\0000000601*)

(*@/// constructor t_pop3.Create(Aowner:TComponent); *)

constructor t_pop3.Create(Aowner:TComponent);

begin

inherited create(Aowner);

f_list:=NIL;

f_mail:=TStringlist.Create;

f_list:=TList.Create;

f_socket_number:=110;

end;

(*@\\\0000000501*)

(*@/// destructor t_pop3.Destroy; *)

destructor t_pop3.Destroy;

begin

f_mail.free;

try

if f_list<>NIL then

while f_list.count>0 do begin

TObject(f_list.items[0]).Free;

f_list.delete(0);

end;

except

end;

f_list.free;

inherited destroy;

end;

(*@\\\0000000C01*)

(*@/// procedure t_pop3.action; *)

procedure t_pop3.action;

begin

login;

if f_list.count<>0 then

getmail(1);

logout;

end;

(*@\\\0000000501*)

(*@/// procedure t_pop3.response; *)

procedure t_pop3.response;

var

s: string;

begin

s:=self.read_line(f_socket);

if assigned(f_tracer) then

f_tracer(s,tt_proto_get);

if copy(s,1,3)='+OK' then

{ everything OK }

else if copy(s,1,4)='-ERR' then

raise EProtocolError.Create('POP3',s,500)

else

raise EProtocolError.Create('POP3',s,999);

end;

(*@\\\0000000701*)

(*@/// procedure t_pop3.Login; // USER, PASS, LIST *)

procedure t_pop3.Login;

var

s: string;

h: t_reply;

begin

inherited login;

self.response;

self.SendCommand('USER '+f_user); (* open connection *)

self.response;

self.write_s(f_socket,'PASS '+f_pass+#13#10);

if assigned(f_tracer) then

f_tracer('PASS *****',tt_proto_sent);

self.response;

self.SendCommand('LIST'); (* open connection *)

self.response;

while true do begin

s:=self.read_line(f_socket);

if s='.' then BREAK;

h:=t_reply.Create;

h.index:=strtoint(copy(s,1,pos(' ',s)-1));

h.length:=strtoint(copy(s,pos(' ',s)+1,length(s)));

h.from:='';

h.subject:='';

f_list.add(h);

end;

end;

(*@\\\*)

(*@/// procedure t_pop3.GetHeaders; // TOP *)

procedure t_pop3.GetHeaders;

var

i: integer;

h: t_reply;

s: string;

begin

f_mail.clear;

for i:=f_list.count-1 downto 0 do begin

h:=t_reply(f_list.items[i]);

self.SendCommand('TOP '+inttostr(h.index)+' 1');

try

self.response; (* this may give a EProtocolError on older POP server *)

while true do begin

s:=self.read_line(f_socket);

if s='.' then BREAK;

if pos('From:',s)=1 then

h.from:=copy(s,7,length(s));

if pos('Subject:',s)=1 then

h.subject:=copy(s,10,length(s));

end;

if h.subject<>'' then

f_mail.insert(0,h.from+#7+h.subject)

else

f_mail.insert(0,h.from)

except

on EProtocolError do

f_mail.insert(0,inttostr(h.index));

(* ignore errors due to unimplemented TOP *)

end;

end;

end;

(*@\\\*)

(*@/// procedure t_pop3.Logout; // QUIT *)

procedure t_pop3.Logout;

begin

if f_logged_in then begin

self.SendCommand('QUIT');

self.response;

end;

inherited logout;

if f_list<>NIL then

while f_list.count>0 do begin

TObject(f_list.items[0]).Free;

f_list.delete(0);

end;

end;

(*@\\\0000000401*)

(*@/// procedure t_pop3.GetMail(index: integer); // RETR *)

procedure t_pop3.GetMail(index: integer);

var

s: string;

begin

if not f_logged_in then login;

self.SendCommand('RETR '+inttostr(index));

self.response;

f_mail.clear;

while true do begin

s:=self.read_line(f_socket);

if s='.' then BREAK;

f_mail.add(s);

end;

end;

(*@\\\0000000601*)

(*@/// procedure t_pop3.DeleteMail(index:integer); // DELE *)

procedure t_pop3.DeleteMail(index:integer);

begin

if not f_logged_in then login;

self.SendCommand('DELE '+inttostr(index));

self.response;

end;

(*@\\\0000000401*)

(*@\\\0000000801*)

(*@/// class t_nntp(t_tcpip) *)

(*@/// function nntpdate(date:TDateTime):string; *)

function nntpdate(date:TDateTime):string;

begin

result:=formatdatetime('yymmdd hhnnss',date);

end;

(*@\\\0000000330*)

(*@/// constructor t_nntp.Create(Aowner:TComponent); *)

constructor t_nntp.Create(Aowner:TComponent);

begin

inherited create(Aowner);

f_news:=TStringlist.Create;

f_newsgroups:=TStringlist.Create;

f_socket_number:=119;

end;

(*@\\\0000000401*)

(*@/// destructor t_nntp.Destroy; *)

destructor t_nntp.Destroy;

begin

f_news.free;

f_newsgroups.free;

inherited destroy;

end;

(*@\\\0000000501*)

(*@/// procedure t_nntp.SetNews(value:TStringlist); *)

procedure t_nntp.SetNews(value:TStringlist);

begin

if value=NIL then

f_news.clear

else

f_news.assign(value);

end;

(*@\\\0000000603*)

(*@/// procedure t_nntp.action; *)

procedure t_nntp.action;

begin

login;

(* ??? *)

logout;

end;

(*@\\\0000000401*)

(*@/// procedure t_nntp.Login; *)

procedure t_nntp.Login;

begin

inherited login;

self.response;

self.SendCommand('MODE READER'); (* some NNTP servers need this *)

try

self.response;

except

(* ignore if the server doesn't understand this *)

end;

end;

(*@\\\0000000508*)

(*@/// procedure t_nntp.Logout; // QUIT *)

procedure t_nntp.Logout;

begin

if f_logged_in then begin

self.SendCommand('QUIT');

self.response;

end;

inherited logout;

end;

(*@\\\0000000306*)

(*@/// procedure t_nntp.GetArticleID(msgid:string); // ARTICLE *)

procedure t_nntp.GetArticleID(const msgid:string);

begin

if not f_logged_in then login;

if msgid[1]<>'<' then

self.SendCommand('ARTICLE <'+msgid+'>')

else

self.SendCommand('ARTICLE '+msgid);

self.response;

f_news.clear;

GetArticleInternally;

end;

(*@\\\0000000301*)

(*@/// procedure t_nntp.PostArticle; // POST *)

procedure t_nntp.PostArticle;

var

i:integer;

begin

if not f_logged_in then login;

self.SendCommand('POST');

self.response;

for i:=0 to f_news.count-1 do begin

if f_news.strings[i]='.' then

write_s(f_socket,'..'+#13#10)

else

write_s(f_socket,f_news.strings[i]+#13#10);

end;

write_s(f_socket,'.'+#13#10);

self.response;

end;

(*@\\\0000000601*)

(*@/// procedure t_nntp.GetAllNewsgroups; // LIST *)

procedure t_nntp.GetAllNewsgroups;

var

s: string;

begin

if not f_logged_in then login;

f_newsgroups.clear;

self.SendCommand('LIST');

self.response;

while true do begin

s:=read_line(f_socket);

if s<>'.' then

f_newsgroups.add(copy(s,1,pos(' ',s)-1))

else

BREAK;

end;

end;

(*@\\\0000000601*)

(*@/// procedure t_nntp.GetNewNewsgroups(since:TDateTime); // NEWGROUPS *)

procedure t_nntp.GetNewNewsgroups(since:TDateTime);

var

s: string;

begin

if not f_logged_in then login;

f_newsgroups.clear;

self.SendCommand('NEWGROUPS '+nntpdate(since));

self.response;

while true do begin

s:=read_line(f_socket);

if s<>'.' then

f_newsgroups.add(copy(s,1,pos(' ',s)-1))

else

BREAK;

end;

end;

(*@\\\0000000601*)

(*@/// procedure t_nntp.SetGroup(group:string; low,high,count: integer); // GROUP *)

procedure t_nntp.SetGroup(const group:string; var low,high,count: integer);

var

s1,s2,s3: integer;

begin

if not f_logged_in then login;

self.SendCommand('GROUP '+group);

self.response;

s1:=pos(' ',f_status_txt);

s2:=posn(' ',f_status_txt,2);

s3:=posn(' ',f_status_txt,3);

count:=strtoint(copy(f_status_txt,1,s1-1));

low:=strtoint(copy(f_status_txt,s1+1,s2-s1-1));

high:=strtoint(copy(f_status_txt,s2+1,s3-s2-1));

end;

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有