程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> TCP/IP(八)

TCP/IP(八)

編輯:Delphi

(*@\000000601*)
(*@/// 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;
(*@\000000401*)
(*@/// 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;
(*@\000000401*)
(*@/// 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;
(*@\000000401*)
(*@/// procedure t_nntp.GetNextArticle;                                  // NEXT *)
procedure t_nntp.GetNextArticle;
begin
  if not f_logged_in then login;
  self.SendCommand(NEXT);
  self.response;
  GetCurrentArticle;
  end;
(*@\000000401*)
(*@/// procedure t_nntp.GetPreviousArticle;                              // LAST *)
procedure t_nntp.GetPreviousArticle;
begin
  if not f_logged_in then login;
  self.SendCommand(LAST);
  self.response;
  GetCurrentArticle;
  end;
(*@\000000401*)

(*@/// 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;
(*@\000000D01*)
(*@/// 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;
(*@\000000301*)
(*@/// 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;
(*@\000000611*)
(*@\000000D01*)

{ 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;
(*@\000000603*)
(*@/// destructor t_mailnews.Destroy; *)
destructor t_mailnews.Destroy;
begin
  f_body.Free;
  f_add_header.Free;
  f_message.Free;
  inherited destroy;
  end;
(*@\000000503*)

(*@/// 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;
(*@\000000603*)
(*@/// 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;
(*@\000000603*)

(*@/// 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;
(*@\000000B01*)
(*@\000000701*)
(*@/// 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;
(*@\000000601*)
(*@/// destructor t_mail.Destroy; *)
destructor t_mail.Destroy;
begin
  f_receipts.Free;
  f_cc.free;
  f_bcc.free;
  inherited destroy;
  end;
(*@\000000601*)

(*@/// 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;
(*@\000000603*)
(*@/// 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;
(*@\000000609*)
(*@/// 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;
(*@\000000601*)

(*@/// 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.

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved