TCP/IP(七）
(*@\\\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;
