⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 idnntp.pas

📁 photo.163.com 相册下载器 多线程下载
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  ALineCount := StrToCard(Fetch(ALine,#9));
  {Extra data}
  AExtraData := ALine;
end;

Procedure TIdNNTP.ParseNewsGroup(ALine : String; out ANewsGroup : String;
            out AHi, ALo : Integer;
            out AStatus : String);
begin
  ANewsgroup := Fetch(ALine, ' ');
  AHi := StrToCard(Fetch(Aline, ' '));
  ALo := StrToCard(Fetch(ALine, ' '));
  AStatus := ALine;
end;

procedure TIdNNTP.InitComponent;
begin
  inherited;
  Mode := mtReader;
  Port := IdPORT_NNTP;

  FRegularProtPort := IdPORT_NNTP;
  FImplicitTLSProtPort := IdPORT_SNEWS;
end;

function TIdNNTP.SendCmd(AOut: string; const AResponse: Array of SmallInt): SmallInt;
begin
  // NOTE: Responses must be passed as arrays so that the proper inherited SendCmd is called
  // and a stack overflow is not caused.
  Result := inherited SendCmd(AOut, []);
  if (Result = 480) or (Result = 450) then begin
    // RLebeau - RFC 2980 says that if the password is not required,
    // then 281 will be returned for the username request, not 381.
    if (inherited SendCmd('AUTHINFO USER ' + Username, [281, 381]) = 381) then begin {do not localize}
      inherited SendCmd('AUTHINFO PASS ' + Password, 281);  {do not localize}
    end;
    Result := inherited SendCmd(AOut, AResponse);
  end else begin
    CheckResponse(Result, AResponse);
  end;
end;

procedure TIdNNTP.Connect;
begin
  inherited;
  AfterConnect;
end;

{ This procedure gets the overview format as suported by the server }
procedure TIdNNTP.GetOverviewFMT(AResponse: TIdStringList);
begin
  SendCmd('LIST OVERVIEW.FMT', 215);  {do not localize}
  IOHandler.Capture(AResponse);
end;

{ Send the XOVER Command.  XOVER [Range]
  Range can be of the form: Article Number i.e. 1
                            Article Number followed by a dash
                            Article Number followed by a dash and aother number
  Remember to select a group first and to issue a GetOverviewFMT so that you
  can interpret the information sent by the server corectly. }
procedure TIdNNTP.XOVER(AParam: string; AResponse: TIdStrings);
begin
  XOVERCommon(AParam);
  IOHandler.Capture(AResponse);
end;

procedure TIdNNTP.XOVER(AParam: string; AResponse: TStream);
begin
  XOVERCommon(AParam);
  IOHandler.Capture(AResponse);
end;

{ Send the XHDR Command.  XHDR Header (Range | Message-ID)
  Range can be of the form: Article Number i.e. 1
                            Article Number followed by a dash
                            Article Number followed by a dash and aother number
  Parm is either the Range or the MessageID of the articles you want. They
  are Mutually Exclusive}
procedure TIdNNTP.XHDR(AHeader: string; AParam: String; AResponse: TIdStrings);
begin
  { This method will send the XHDR command.
  The programmer is responsible for choosing the correct header. Headers
  that should always work as per RFC 1036 are:

      From
      Date
      Newsgroups
      Subject
      Message-ID
      Path

    These Headers may work... They are optional per RFC1036 and new headers can
    be added at any time as server implementation changes

      Reply-To
      Sender
      Followup-To
      Expires
      References
      Control
      Distribution
      Organization
      Keywords
      Summary
      Approved
      Lines
      Xref
    }
  Self.XHDRCommon(AHeader,AParam);
  IOHandler.Capture(AResponse);
end;

procedure TIdNNTP.SelectGroup(AGroup: string);
var
  s: string;
begin
  SendCmd('Group ' + AGroup, [211]);  {do not localize}
  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: TIdStringList);
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  {do not localize}
      MsgID := AMsg.Strings[i];
      Fetch(MsgID,':');
      Break;
    end;
  SendCmd('IHAVE ' + MsgID, 335); {do not localize}
  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: TIdStringList; var AResponses: TIdStringList);
var
  i: Integer;
begin
  if not Assigned(AResponses) then begin
    raise EIdNNTPStringListNotInitialized.Create(RSNNTPStringListNotInitialized);
  end;
  for i := 0 to AMsgIDs.Count - 1 do begin
    IOHandler.WriteLn('CHECK '+ AMsgIDs.Strings[i]);  {do not localize}
  end;
  for i := 0 to AMsgIDs.Count - 1 do begin
    AResponses.Add(IOHandler.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(AMsgID: string; AMsg: TIdStreamVCL): string;
// This message assumes AMsg is "raw" and has already taken care of . to ..
begin
  SendCmd('TAKETHIS ' + AMsgID, 239); {do not localize}
  IOHandler.Write(AMsg);
  IOHandler.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); {do not localize}
  //Header
  if Length(NewsAgent) > 0 then begin
    AMsg.ExtraHeaders.Values['X-Newsreader'] := NewsAgent;  {do not localize}
  end;
  SendMsg(AMsg);
  SendCmd('.', 240);
end;

procedure TIdNNTP.Post(AStream: TIdStreamVCL);
begin
  SendCmd('POST', 340); {do not localize}
  IOHandler.Write(AStream);
  SendCmd('.', 240);
end;

procedure TIdNNTP.ProcessGroupList(ACmd: string; AResponse: integer;
 ALisTIdEvent: TIdEvenTIdNewsgroupList);
var
  s1, sNewsgroup: string;
  lLo, lHi: Integer;
  sStatus: string;
  LCanContinue: Boolean;
begin
  BeginWork(wmRead, 0); try
    SendCmd(ACmd, AResponse);
    s1 := IOHandler.ReadLn;
    LCanContinue := True;
    while (s1 <> '.') and LCanContinue do
    begin
      ParseNewsGroup(s1, sNewsgroup, lHi, lLo, sStatus);
      ALisTIdEvent(sNewsgroup, lLo, lHi, sStatus, LCanContinue);
      s1 := IOHandler.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);  {do not localize}
end;

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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -