idnntpserver.pas

delphi indy9.0.18组件包

    property OnListExtensions : TIdServerThreadEvent read FOnListExtensions
      write FOnListExtensions;
    property OnListHeaders : TIdServerThreadEvent read FOnListHeaders write FOnListHeaders;
    property OnListSubscriptions : TIdServerThreadEvent read FOnListSubscriptions
      write FOnListSubscriptions;
    property OnListGroups: TIdServerThreadEvent read FOnListGroups write FOnListGroups;
    property OnListGroup : TIdServerThreadEvent read FOnListGroup write FOnListGroup;
    property OnListNewGroups : TIdNNTPOnNewGroupsList read FOnListNewGroups
      write FOnListNewGroups;
    property OnSelectGroup: TIdNNTPOnSelectGroup read FOnSelectGroup write FOnSelectGroup;
    property OnPost: TIdNNTPOnPost read FOnPost write FOnPost;
    property OverviewFormat: TStrings read FOverviewFormat write SetOverviewFormat;
    property OnXHdr: TIdNNTPOnXHdr read FOnXHdr write FOnXHdr;
    property OnXOver: TIdNNTPOnXOver read FOnXOver write FOnXOver;
    property OnXROver: TIdNNTPOnXOver read FOnXROver write FOnXROver;
    property OnXPat: TIdNNTPOnXPat read FOnXPat write FOnXPat;
    property OnNewNews : TIdNNTPOnNewNews read FOnNewNews write FOnNewNews;
    property OnIHaveCheck : TIdNNTPOnIHaveCheck read FOnIHaveCheck write FOnIHaveCheck;
    property OnIHavePost: TIdNNTPOnPost read FOnIHavePost write FOnIHavePost;
  end;

implementation

uses
  IdResourceStrings, IdRFCReply,
  SysUtils;

class function TIdNNTPServer.NNTPTimeToTime(const ATimeStamp : String): TDateTime;
var
  LHr, LMn, LSec : Word;
  LTimeStr : String;
begin
  LTimeStr := ATimeStamp;
  if LTimeStr <> '' then
  begin
    LHr := StrToIntDef(Copy(LTimeStr,1,2),1);
    Delete(LTimeStr,1,2);
    LMn := StrToIntDef(Copy(LTimeStr,1,2),1);
    Delete(LTimeStr,1,2);
    LSec := StrToIntDef(Copy(LTimeStr,1,2),1);
    Delete(LTimeStr,1,2);
    Result := EncodeTime(LHr, LMn, LSec,0);
    LTimeStr := Trim(LTimeStr);
    if UpperCase(LTimeStr)='GMT' then
    begin
      // Apply local offset
      Result := Result + OffSetFromUTC;
    end;
  end else begin
    Result := 0;
  end;
end;

class function TIdNNTPServer.NNTPDateTimeToDateTime(const ATimeStamp : String): TDateTime;
var
  LYr, LMo, LDay : Word;
    LTimeStr : String;
    LDateStr : String;
begin
  Result := 0;
  if ATimeStamp <> '' then begin
    LTimeStr := ATimeStamp;
    LDateStr := Fetch(LTimeStr);
    if (Length(LDateStr) > 6) then begin
      //four digit year, good idea - IMAO
      LYr := StrToIntDef(Copy(LDateStr,1,4),1969);
      Delete(LDateStr,1,4);
    end else begin
      LYr := StrToIntDef(Copy(LDateStr,1,2),69);
      Delete(LDateStr,1,2);
      LYr := LYr + 2000;
    end;
    LMo := StrToIntDef(Copy(LDateStr,1,2),1);
    Delete(LDateStr,1,2);
    LDay := StrToIntDef(Copy(LDateStr,1,2),1);
    Delete(LDateStr,1,2);
    Result := EncodeDate(LYr, LMo, LDay) + NNTPTimeToTime(LTimeStr);
  end;
end;

(*
3.1.  The ARTICLE, BODY, HEAD, and STAT commands

   There are two forms to the ARTICLE command (and the related BODY,
   HEAD, and STAT commands), each using a different method of specifying
   which article is to be retrieved.  When the ARTICLE command is
   followed by a message-id in angle brackets ("<" and ">"), the first
   form of the command is used; when a numeric parameter or no parameter
   is supplied, the second form is invoked.

   The text of the article is returned as a textual response, as
   described earlier in this document.

   The HEAD and BODY commands are identical to the ARTICLE command
   except that they respectively return only the header lines or text
   body of the article.

   The STAT command is similar to the ARTICLE command except that no
   text is returned.  When selecting by message number within a group,
   the STAT command serves to set the current article pointer without
   sending text. The returned acknowledgement response will contain the
   message-id, which may be of some value.  Using the STAT command to
   select by message-id is valid but of questionable value, since a
   selection by message-id does NOT alter the "current article pointer".

3.1.1.  ARTICLE (selection by message-id)

   ARTICLE <message-id>

   Display the header, a blank line, then the body (text) of the
   specified article.  Message-id is the message id of an article as
   shown in that article's header.  It is anticipated that the client
   will obtain the message-id from a list provided by the NEWNEWS
   command, from references contained within another article, or from
   the message-id provided in the response to some other commands.

   Please note that the internally-maintained "current article pointer"
   is NOT ALTERED by this command. This is both to facilitate the
   presentation of articles that may be referenced within an article
   being read, and because of the semantic difficulties of determining
   the proper sequence and membership of an article which may have been
   posted to more than one newsgroup.

3.1.2.  ARTICLE (selection by number)

   ARTICLE [nnn]

   Displays the header, a blank line, then the body (text) of the
   current or specified article.  The optional parameter nnn is the

   numeric id of an article in the current newsgroup and must be chosen
   from the range of articles provided when the newsgroup was selected.
   If it is omitted, the current article is assumed.

   The internally-maintained "current article pointer" is set by this
   command if a valid article number is specified.

   [the following applies to both forms of the article command.] A
   response indicating the current article number, a message-id string,
   and that text is to follow will be returned.

   The message-id string returned is an identification string contained
   within angle brackets ("<" and ">"), which is derived from the header
   of the article itself.  The Message-ID header line (required by
   RFC850) from the article must be used to supply this information. If
   the message-id header line is missing from the article, a single
   digit "0" (zero) should be supplied within the angle brackets.

   Since the message-id field is unique with each article, it may be
   used by a news reading program to skip duplicate displays of articles
   that have been posted more than once, or to more than one newsgroup.

3.1.3.  Responses

   220 n <a> article retrieved - head and body follow
           (n = article number, <a> = message-id)
   221 n <a> article retrieved - head follows
   222 n <a> article retrieved - body follows
   223 n <a> article retrieved - request text separately
   412 no newsgroup has been selected
   420 no current article has been selected
   423 no such article number in this group
   430 no such article found
*)

procedure TIdNNTPServer.CommandArticle(ASender: TIdCommand);
var
  LMsgID: string;
  LMsgNo: Integer;
  LThread: TIdNNTPThread;
begin
  if not Assigned(OnArticleByNo) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then
  begin
    if LookupMessage(ASender, LMsgNo, LMsgID) then
    begin
      LThread := TidNNTPThread (ASender.Thread);
      ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - head and body follows');
      ASender.SendReply;
      OnArticleByNo(LThread, LMsgNo)
    end;
  end
end;

procedure TIdNNTPServer.CommandBody(ASender: TIdCommand);
var
  LMsgID: string;
  LMsgNo: Integer;
  LThread: TIdNNTPThread;
begin
  if not Assigned(OnBodyByNo) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then
  begin
    if LookupMessage(ASender, LMsgNo, LMsgID) then
    begin
      LThread := TidNNTPThread (ASender.Thread);
      ASender.Reply.SetReply(222, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - body follows');
      ASender.SendReply;
      OnBodyByNo(LThread, LMsgNo)
    end;
  end
end;

procedure TIdNNTPServer.CommandDate(ASender: TIdCommand);
begin
  ASender.Reply.SetReply(111, FormatDateTime('yyyymmddhhnnss', Now + IdGlobal.TimeZoneBias));
end;

(*
3.2.  The GROUP command

3.2.1.  GROUP

   GROUP ggg

   The required parameter ggg is the name of the newsgroup to be
   selected (e.g. "net.news").  A list of valid newsgroups may be
   obtained from the LIST command.

   The successful selection response will return the article numbers of
   the first and last articles in the group, and an estimate of the
   number of articles on file in the group.  It is not necessary that
   the estimate be correct, although that is helpful; it must only be
   equal to or larger than the actual number of articles on file.  (Some
   implementations will actually count the number of articles on file.
   Others will just subtract first article number from last to get an
   estimate.)

   When a valid group is selected by means of this command, the
   internally maintained "current article pointer" is set to the first
   article in the group.  If an invalid group is specified, the
   previously selected group and article remain selected.  If an empty
   newsgroup is selected, the "current article pointer" is in an
   indeterminate state and should not be used.

   Note that the name of the newsgroup is not case-dependent.  It must
   otherwise match a newsgroup obtained from the LIST command or an
   error will result.

3.2.2.  Responses

   211 n f l s group selected
           (n = estimated number of articles in group,
           f = first article number in the group,
           l = last article number in the group,
           s = name of the group.)
   411 no such news group
*)
procedure TIdNNTPServer.CommandGroup(ASender: TIdCommand);
var
  LGroup: string;
  LGroupExists: Boolean;
  LMsgCount: Integer;
  LMsgFirst: Integer;
  LMsgLast: Integer;
  LThread: TIdNNTPThread;
begin
  if not AuthRequired(ASender) then begin
    LThread := TIdNNTPThread(ASender.Thread);
    LGroup := Trim(ASender.UnparsedParams);
    if Length(LGroup) <> 0 then begin
      LGroupExists := False;
      DoSelectGroup(LThread, LGroup, LMsgCount, LMsgFirst, LMsgLast, LGroupExists);
      if LGroupExists then begin
        LThread.FCurrentGroup := LGroup;
        LThread.FCurrentArticle := LMsgFirst;
        ASender.Reply.SetReply(211, Format('%d %d %d %s', [LMsgCount, LMsgFirst, LMsgLast, LGroup]));
      end;
    end else begin
      ASender.Reply.NumericCode := 501;
    end;
  end;
end;

procedure TIdNNTPServer.CommandHead(ASender: TIdCommand);
var
  LMsgID: string;
  LMsgNo: Integer;
begin
  if not Assigned(OnHeadByNo) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then
  begin
    if LookupMessage(ASender, LMsgNo, LMsgID) then
    begin
      ASender.Reply.SetReply(221, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - head follows');
      ASender.SendReply;
      OnHeadByNo(TIdNNTPThread(ASender.Thread), LMsgNo)
    end;
  end;
end;

(*
3.3.  The HELP command

3.3.1.  HELP

   HELP

   Provides a short summary of commands that are understood by this
   implementation of the server. The help text will be presented as a
   textual response, terminated by a single period on a line by itself.

   3.3.2.  Responses

   100 help text follows
*)
procedure TIdNNTPServer.CommandHelp(ASender: TIdCommand);
begin
  if (Help.Count > 0) then begin
    ASender.Response.Assign(Help);
  end else begin
    ASender.Response.Text := 'No help available.';
  end;
end;

procedure TIdNNTPServer.CommandIHave(ASender: TIdCommand);
var LThread : TIdNNTPThread;
    LMsgID : String;
    LAccept:Boolean;
    LErrorText : String;
begin
  if not Assigned(OnIHaveCheck) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then begin
    LThread := TIdNNTPThread(ASender.Thread);
    LMsgID := Trim(ASender.UnparsedParams);
    if (Copy(LMsgID, 1, 1) = '<') then begin
      FOnIHaveCheck(LThread, LMsgID, LAccept);
      if LAccept then
      begin
        ASender.Reply.SetReply(335, 'News to me! <CRLF.CRLF> to end.');
        ASender.SendReply;
        LErrorText := '';
        OnPost(LThread, LAccept, LErrorText);
        ASender.Reply.SetReply(iif(LAccept, 235, 436), LErrorText);
      end
      else
      begin
        ASender.Reply.NumericCode := 435;
      end;