TCP/IP(八)

最新推荐文章于 2025-01-10 17:45:28 发布

原创最新推荐文章于 2025-01-10 17:45:28 发布 · 816 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#destructor #integer #constructor #login #string #header

博客主要围绕NNTP协议相关操作和邮件新闻组件展开。包含NNTP获取文章、设置当前文章等操作，以及邮件新闻组件的构造、析构和设置内容等方法，还涉及邮件发送时收件人、抄送、密送等信息的处理。

(*@///0000000601*)
(*@/// procedure t_nntp.GetArticleNr(index:integer);                     // ARTICLE *)
procedure t_nntp.GetArticleNr(index:integer);
begin
if not f_logged_in then login;
self.SendCommand('ARTICLE '+inttostr(index));
self.response;
f_news.clear;
GetArticleInternally;
end;
(*@///0000000401*)
(*@/// procedure t_nntp.SetCurrentArticle(index:integer);                // STAT *)
procedure t_nntp.SetCurrentArticle(index:integer);
begin
if not f_logged_in then login;
self.SendCommand('STAT '+inttostr(index));
self.response;
end;
(*@///0000000401*)
(*@/// procedure t_nntp.GetCurrentArticle;                               // HEAD and BODY *)
procedure t_nntp.GetCurrentArticle;
begin
if not f_logged_in then login;
f_news.clear;
self.SendCommand('HEAD');
GetArticleInternally;
f_news.add('');
self.SendCommand('BODY');
GetArticleInternally;
end;
(*@///0000000401*)
(*@/// procedure t_nntp.GetNextArticle;                                  // NEXT *)
procedure t_nntp.GetNextArticle;
begin
if not f_logged_in then login;
self.SendCommand('NEXT');
self.response;
GetCurrentArticle;
end;
(*@///0000000401*)
(*@/// procedure t_nntp.GetPreviousArticle;                              // LAST *)
procedure t_nntp.GetPreviousArticle;
begin
if not f_logged_in then login;
self.SendCommand('LAST');
self.response;
GetCurrentArticle;
end;
(*@///0000000401*)

(*@/// procedure t_nntp.response; *)
procedure t_nntp.response;
var
s: string;
begin
s:=self.read_line(f_socket);
if assigned(f_tracer) then
    f_tracer(s,tt_proto_get);
try
    f_status_nr:=strtoint(copy(s,1,3));
except
    f_status_nr:=999;
end;
f_status_txt:=copy(s,5,length(s));
if f_status_nr>=400 then
    raise EProtocolError.Create('NNTP',f_status_txt,f_status_nr);
end;
(*@///0000000D01*)
(*@/// procedure t_nntp.GetArticle(group:string; index:integer); *)
procedure t_nntp.GetArticle(const group:string; index:integer);
begin
self.SendCommand('GROUP '+group);
self.response;
GetArticleNr(index);
end;
(*@///0000000301*)
(*@/// procedure t_nntp.GetArticleInternally; *)
procedure t_nntp.GetArticleInternally;
var
s: string;
begin
while true do begin
    s:=read_line(f_socket);
    if s<>'.' then
      f_news.add(s)
    else
      BREAK;
    end;
end;
(*@///0000000611*)
(*@///0000000D01*)

{ Mail and News text components }
(*@/// class t_mailnews(tcomponent) *)
(*@/// constructor t_mailnews.Create(Aowner:TComponent); *)
constructor t_mailnews.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_body:=TStringList.Create;
f_add_header:=TStringList.Create;
f_message:=TStringList.Create;
end;
(*@///0000000603*)
(*@/// destructor t_mailnews.Destroy; *)
destructor t_mailnews.Destroy;
begin
f_body.Free;
f_add_header.Free;
f_message.Free;
inherited destroy;
end;
(*@///0000000503*)

(*@/// procedure t_mailnews.SetBody(Value: TStringList); *)
procedure t_mailnews.SetBody(Value: TStringList);
begin
if value=NIL then
    f_body.clear
else
    f_body.assign(value);
end;
(*@///0000000603*)
(*@/// procedure t_mailnews.SetHeader(Value: TStringList); *)
procedure t_mailnews.SetHeader(Value: TStringList);
begin
if value=NIL then
    f_add_header.clear
else
    f_add_header.assign(value);
end;
(*@///0000000603*)

(*@/// procedure t_mailnews.action; *)
procedure t_mailnews.action;
begin
f_message.insert(0,'From: '+f_from); (* normally the first *)
if f_sender<>'' then f_message.add('Sender: '+f_sender);
f_message.insert(1,'Message-ID: <'+inttostr(round((now-encodedate(1970,1,1))*86400))+'@'
+my_hostname+'>');
f_message.insert(2,'Date: '+internet_date(now));
f_message.insert(3,'Subject: '+f_subject);
if f_references<>'' then f_message.add('References: '+f_references);
if f_replyto<>'' then f_message.add('Reply-To: '+f_replyto);
f_message.addstrings(f_add_header);
f_message.add(''); (* An empty line to separate header from body *)
f_message.addstrings(f_body);
end;
(*@///0000000B01*)
(*@///0000000701*)
(*@/// class t_mail(t_mailnews) *)
(*@/// constructor t_mail.Create(Aowner:TComponent); *)
constructor t_mail.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_smtp:=NIL;
f_receipts:=TStringList.Create;
f_cc:=TStringList.Create;
f_bcc:=TStringList.Create;
end;
(*@///0000000601*)
(*@/// destructor t_mail.Destroy; *)
destructor t_mail.Destroy;
begin
f_receipts.Free;
f_cc.free;
f_bcc.free;
inherited destroy;
end;
(*@///0000000601*)

(*@/// procedure t_mail.SetRecipients(Value: TStringList); *)
procedure t_mail.SetRecipients(Value: TStringList);
begin
if value=NIL then
    f_receipts.clear
else
    f_receipts.assign(value);
end;
(*@///0000000603*)
(*@/// procedure t_mail.SetCC(Value: TStringList); *)
procedure t_mail.SetCC(Value: TStringList);
begin
if value=NIL then
    f_cc.clear
else
    f_cc.assign(value);
end;
(*@///0000000609*)
(*@/// procedure t_mail.SetBCC(Value: TStringList); *)
procedure t_mail.SetBCC(Value: TStringList);
begin
if value=NIL then
    f_bcc.clear
else
    f_bcc.assign(value);
end;
(*@///0000000601*)

(*@/// procedure t_mail.action; *)
procedure t_mail.action;
var
i: integer;
clear_sender: boolean;
begin
if (f_smtp=NIL) or (f_receipts=NIL) or (f_receipts.count=0)
    or (f_from='') then EXIT;
clear_sender:=(f_smtp.Sender='');
if clear_sender then begin
    if f_sender<>'' then
      f_smtp.sender:=f_sender
    else
      f_smtp.sender:=f_from;
    end;

if f_disclose_receipts then
    f_message.add('To: disclosed recipients list')
else
    for i:=0 to f_receipts.count-1 do begin
      f_message.add('To: '+f_receipts.strings[i]);
      end;
f_smtp.Recipients:=f_receipts;
for i:=0 to f_cc.count-1 do begin
    f_message.add('CC: '+f_cc.strings[i]);
    f_smtp.Recipients.add(f_cc.strings[i]);
    end;
for i:=0 to f_bcc.count-1 do begin
    f_smtp.Recipients.add(f_bcc.strings[i]);
    end;

inherited action;
f_smtp.message:=f_message;
f_smtp.action;
f_message.clear;
if clear_sender then
f_smtp.sender:='';
end;