idnntp.pas

Indy控件的使用源代码

      Control
      Distribution
      Organization
      Keywords
      Summary
      Approved
      Lines
      Xref
    }
  SendCmd('XHDR ' + AHeader + ' ' + AParam, 221);
  Capture(AResponse);
end;

procedure TIdNNTP.SelectGroup(const AGroup: string);
var
  s: string;
begin
  SendCmd('Group ' + AGroup, [211]);
  s := LastCmdResult.Text[0];
  FlMsgCount := StrToCard(Fetch(s));
  FlMsgLow := StrToCard(Fetch(s));
  FlMsgHigh := StrToCard(Fetch(s));
end;

{ This method will send messages via the IHAVE command.
The IHAVE command first sends the message ID and waits for a response from the
server prior to sending the header and body. This command is of no practical
use for NNTP client readers as readers are generally denied the privelege
to execute the IHAVE command. this is a news transport command. So use this
when you are implementing a NNTP server send unit }

procedure TIdNNTP.IHAVE(AMsg: TStringList);
var
  i     : Integer;
  MsgID : string;
begin
//TODO: Im not sure this fucntion works properly - needs checked
// Why is it not using a TIdMessage?
  // Since we are merely forwarding messages we have already received
  // it is assumed that the required header fields and body are already in place

  // We need to get the message ID from the stringlist because it's required
  // that we send it s part of the IHAVE command
  for i := 0 to AMsg.Count - 1 do
    if IndyPos('Message-ID',AMsg.Strings[i]) > 0 then begin
      MsgID := AMsg.Strings[i];
      Fetch(MsgID,':');
      Break;
    end;
  SendCmd('IHAVE ' + MsgID, 335);
  WriteRFCStrings(AMsg);
  // Why is the response ignored? What is it?
  Readln;
end;

(*
1.1.1  The CHECK command

   CHECK <message-id>

   CHECK is used by a peer to discover if the article with the specified
   message-id should be sent to the server using the TAKETHIS command.
   The peer does not have to wait for a response from the server before
   sending the next command.

   From using the responses to the sequence of CHECK commands, a list of
   articles to be sent can be constructed for subsequent use by the
   TAKETHIS command.

   The use of the CHECK command for streaming is optional.  Some
   implementations will directly use the TAKETHIS command and send all
   articles in the send queue on that peer for the server.

   On some implementations, the use of the CHECK command is not
   permitted when the server is in slave mode (via the SLAVE command).

   Responses that are of the form X3X must specify the message-id in the
   response.

1.1.2.  Responses

      238 no such article found, please send it to me
      400 not accepting articles
      431 try sending it again later
      438 already have it, please don't send it to me
      480 Transfer permission denied
      500 Command not understood
*)
procedure TIdNNTP.Check(AMsgIDs: TStringList; var AResponses: TStringList);
var
  i: Integer;
begin
  if not Assigned(AResponses) then begin
    raise EIdNNTPStringListNotInitialized.Create(RSNNTPStringListNotInitialized);
  end;
  for i := 0 to AMsgIDs.Count - 1 do begin
    WriteLn('CHECK '+ AMsgIDs.Strings[i]);
  end;
  for i := 0 to AMsgIDs.Count - 1 do begin
    AResponses.Add(ReadLn)
  end;
end;

(*
1.3.1  The TAKETHIS command

   TAKETHIS <message-id>

   TAKETHIS is used to send articles to a server when in streaming mode.
   The entire article (header and body, in that sequence) is sent
   immediately after the peer sends the TAKETHIS command.  The peer does
   not have to wait for a response from the server before sending the
   next command and the associated article.

   During transmission of the article, the peer should send the entire
   article, including header and body, in the manner specified for text
   transmission from the server.  See RFC 977, Section 2.4.1 for
   details.

   Responses that are of the form X3X must specify the message-id in the
   response.

1.3.2.  Responses

      239 article transferred ok
      400 not accepting articles
      439 article transfer failed
      480 Transfer permission denied
      500 Command not understood
*)
function TIdNNTP.TakeThis(const AMsgID: string; AMsg: TStream): string;
// This message assumes AMsg is "raw" and has already taken care of . to ..
begin
  SendCmd('TAKETHIS ' + AMsgID, 239);
  WriteStream(AMsg);
  WriteLn('.');
end;

(*
3.10.  The POST command

3.10.1.  POST

   POST

   If posting is allowed, response code 340 is returned to indicate that
   the article to be posted should be sent. Response code 440 indicates
   that posting is prohibited for some installation-dependent reason.

   If posting is permitted, the article should be presented in the
   format specified by RFC850, and should include all required header
   lines. After the article's header and body have been completely sent
   by the client to the server, a further response code will be returned
   to indicate success or failure of the posting attempt.

   The text forming the header and body of the message to be posted
   should be sent by the client using the conventions for text received
   from the news server:  A single period (".") on a line indicates the
   end of the text, with lines starting with a period in the original
   text having that period doubled during transmission.

   No attempt shall be made by the server to filter characters, fold or
   limit lines, or otherwise process incoming text.  It is our intent
   that the server just pass the incoming message to be posted to the
   server installation's news posting software, which is separate from
   this specification.  See RFC850 for more details.

   Since most installations will want the client news program to allow
   the user to prepare his message using some sort of text editor, and
   transmit it to the server for posting only after it is composed, the
   client program should take note of the herald message that greeted it
   when the connection was first established. This message indicates
   whether postings from that client are permitted or not, and can be
   used to caution the user that his access is read-only if that is the
   case. This will prevent the user from wasting a good deal of time
   composing a message only to find posting of the message was denied.
   The method and determination of which clients and hosts may post is
   installation dependent and is not covered by this specification.

3.10.2.  Responses

   240 article posted ok
   340 send article to be posted. End with <CR-LF>.<CR-LF>
   440 posting not allowed
   441 posting failed

   (for reference, one of the following codes will be sent upon initial
   connection; the client program should determine whether posting is
   generally permitted from these:) 200 server ready - posting allowed
   201 server ready - no posting allowed
*)
procedure TIdNNTP.Post(AMsg: TIdMessage);
begin
  SendCmd('POST', 340);
  //Header
  if Length(NewsAgent) > 0 then begin
    AMsg.ExtraHeaders.Values['X-Newsreader'] := NewsAgent;
  end;
  SendMsg(AMsg);
  SendCmd('.', 240);
end;

procedure TIdNNTP.Post(AStream: TStream);
begin
  SendCmd('POST', 340);
  WriteStream(AStream);
  GetResponse(240);
end;

procedure TIdNNTP.ProcessGroupList(const ACmd: string; const AResponse: integer;
 const AListEvent: TEventNewsgroupList);
var
  s1, sNewsgroup: string;
  lLo, lHi: Integer;
  sStatus: string;
  LCanContinue: Boolean;
begin
  BeginWork(wmRead, 0); try
    SendCmd(ACmd, AResponse);
    s1 := ReadLn;
    LCanContinue := True;
    while (s1 <> '.') and LCanContinue do
    begin
      ParseNewsGroup(s1, sNewsgroup, lHi, lLo, sStatus);
      AListEvent(sNewsgroup, lLo, lHi, sStatus, LCanContinue);
      s1 := ReadLn;
    end;
  finally
    EndWork(wmRead);
  end;
end;

procedure TIdNNTP.GetNewsgroupList;
begin
  if not Assigned(FOnNewsgroupList) then begin
    raise EIdNNTPNoOnNewsgroupList.Create(RSNNTPNoOnNewsgroupList);
  end;
  ProcessGroupList('LIST', 215, FOnNewsgroupList);
end;

procedure TIdNNTP.GetNewGroupsList(const ADate: TDateTime; const AGMT: boolean;
 const ADistributions: string);
begin
  if not Assigned(FOnNewGroupsList) then begin
    raise EIdNNTPNoOnNewGroupsList.Create(RSNNTPNoOnNewGroupsList);
  end;
  ProcessGroupList('NEWGROUPS ' + ConvertDateTimeDist(ADate, AGMT, ADistributions), 231
   , FOnNewGroupsList);
end;

procedure TIdNNTP.GetNewNewsList(const ANewsgroups: string;
 const ADate: TDateTime; const AGMT: boolean; ADistributions: string);
var
  s1: string;
  CanContinue: Boolean;
begin
  if not Assigned(FOnNewNewsList) then begin
    raise EIdNNTPNoOnNewNewsList.Create(RSNNTPNoOnNewNewsList);
  end;

  BeginWork(wmRead,0); try
    SendCmd('NEWNEWS ' + ANewsgroups + ' ' + ConvertDateTimeDist(ADate, AGMT, ADistributions), 230);
    s1 := ReadLn;
    CanContinue := True;
    while (s1 <> '.') and CanContinue do begin
      FOnNewNewsList(s1, CanContinue);
      s1 := ReadLn;
    end;
  finally
    EndWork(wmRead);
  end;
end;

(*
3.9.  The NEXT command

3.9.1.  NEXT

   NEXT

   The internally maintained "current article pointer" is advanced to
   the next article in the current newsgroup.  If no more articles
   remain in the current group, an error message is returned and the
   current article remains selected.

   The internally-maintained "current article pointer" is set by this
   command.

   A response indicating the current article number, and the message-id
   string will be returned.  No text is sent in response to this
   command.

3.9.2.  Responses

   223 n a article retrieved - request text separately
           (n = article number, a = unique article id)
   412 no newsgroup selected
   420 no current article has been selected
   421 no next article in this group
*)
function TIdNNTP.Next: Boolean;
begin
  Result := SendCmd('NEXT', [223, 421]) = 223;
end;

(*
3.5.  The LAST command

3.5.1.  LAST

   LAST

   The internally maintained "current article pointer" is set to the
   previous article in the current newsgroup.  If already positioned at
   the first article of the newsgroup, an error message is returned and
   the current article remains selected.

   The internally-maintained "current article pointer" is set by this
   command.

   A response indicating the current article number, and a message-id
   string will be returned.  No text is sent in response to this
   command.

3.5.2.  Responses

   223 n a article retrieved - request text separately
           (n = article number, a = unique article id)
   412 no newsgroup selected
   420 no current article has been selected
   422 no previous article in this group
*)
function TIdNNTP.Previous: Boolean;
begin
  Result := SendCmd('LAST', [223, 422]) = 223;
end;

function TIdNNTP.SelectArticle(const AMsgNo: Integer): Boolean;
begin
  Result := SendCmd('STAT ' + IntToStr(AMsgNo), [223, 423]) = 223;
end;

procedure TIdNNTP.GetNewsgroupList(AList: TStrings);
begin
  SendCmd('LIST', 215);
  Capture(AList);
end;