idnntp.pas

photo.163.com 相册下载器 多线程下载

    AMsg.Clear;
    IOHandler.Capture(AMsg);
  end;
end;

function TIdNNTP.GetBody(AMsg: TStream): Boolean;
begin
  Result := True;
  SendCmd('BODY', 222); {do not localize}
  IOHandler.Capture(AMsg);
end;

function TIdNNTP.GetBody(AMsgNo: Integer; AMsg: TStream): Boolean;
begin
  Result := SendCmd('BODY ' + IntToStr(AMsgNo), [222, 423]) = 222;  {do not localize}
  if Result then begin
    IOHandler.Capture(AMsg);
  end;
end;

function TIdNNTP.GetBody(AMsgID: string; AMsg: TStream): Boolean;
begin
  Result := SendCmd('BODY ' + EnsureMsgIDBrackets(AMsgID), [222, 430]) = 222;  {do not localize}
  if Result then begin
    IOHandler.Capture(AMsg);
  end;
end;

function TIdNNTP.GetHeader(AMsg: TIdMessage): Boolean;
begin
  Result := True;
  SendCmd('HEAD', 221); {do not localize}
  AMsg.Clear;
  ReceiveHeader(AMsg);
end;

function TIdNNTP.GetHeader(AMsgNo: Integer; AMsg: TIdMessage): Boolean;
begin
  Result := SendCmd('HEAD ' + IntToStr(AMsgNo), [221, 423]) = 221;  {do not localize}
  if Result then begin
    AMsg.Clear;
    ReceiveHeader(AMsg);
  end;
end;

function TIdNNTP.GetHeader(AMsgID: string; AMsg: TIdMessage): Boolean;
begin
  Result := SendCmd('HEAD ' + EnsureMsgIDBrackets(AMsgID), [221, 430]) = 221;  {do not localize}
  if Result then begin
    AMsg.Clear;
    ReceiveHeader(AMsg);
  end;
end;

function TIdNNTP.GetHeader(AMsg: TIdStrings): Boolean;
begin
  Result := True;
  SendCmd('HEAD', 221); {do not localize}
  AMsg.Clear;
  IOHandler.Capture(AMsg);
end;

function TIdNNTP.GetHeader(AMsgNo: Integer; AMsg: TIdStrings): Boolean;
begin
  Result := SendCmd('HEAD ' + IntToStr(AMsgNo), [221, 423]) = 221;  {do not localize}
  if Result then begin
    AMsg.Clear;
    IOHandler.Capture(AMsg);
  end;
end;

function TIdNNTP.GetHeader(AMsgID: string; AMsg: TIdStrings): Boolean;
begin
  Result := SendCmd('HEAD ' + EnsureMsgIDBrackets(AMsgID), [221, 430]) = 221;  {do not localize}
  if Result then begin
    AMsg.Clear;
    IOHandler.Capture(AMsg);
  end;
end;

function TIdNNTP.GetHeader(AMsg: TStream): Boolean;
begin
  Result := True;
  SendCmd('HEAD', 221); {do not localize}
  IOHandler.Capture(AMsg);
end;

function TIdNNTP.GetHeader(AMsgNo: Integer; AMsg: TStream): Boolean;
begin
  Result := SendCmd('HEAD ' + IntToStr(AMsgNo), [221, 423]) = 221;  {do not localize}
  if Result then begin
    IOHandler.Capture(AMsg);
  end;
end;

function TIdNNTP.GetHeader(AMsgID: string; AMsg: TStream): Boolean;
begin
  Result := SendCmd('HEAD ' + EnsureMsgIDBrackets(AMsgID), [221, 430]) = 221;  {do not localize}
  if Result then begin
    IOHandler.Capture(AMsg);
  end;
end;

procedure TIdNNTP.GetNewsgroupList(AStream: TStream);
begin
  SendCmd('LIST', 215); {do not localize}
  IOHandler.Capture(AStream);
end;

procedure TIdNNTP.AfterConnect;
begin
  try
    GetResponse([]);
    // Here lets check to see what condition we are in after being greeted by
    // the server. The application utilizing NNTPWinshoe should check the value
    // of GreetingResult to determine if further action is warranted.

    case LastCmdResult.NumericCode of
      200: FPermission := crCanPost;
      201: FPermission := crNoPost;
      400: FPermission := crTempUnavailable;
      // This should never happen because the server should immediately close
      // the connection but just in case ....
      // Kudzu: Changed this to an exception, otherwise it produces non-standard usage by the
      // users code
      502: raise EIdNNTPConnectionRefused.CreateError(502, RSNNTPConnectionRefused);
    end;
    // here we call SeTIdMode on the value stored in mode to make sure we can
    // use the mode we have selected
    case Mode of
      mtStream: begin
        SendCmd('MODE STREAM'); {do not localize}
        if LastCmdResult.NumericCode <> 203 then begin
          ModeResult := mrNoStream
        end else begin
          ModeResult := mrCanStream;
        end;
      end;
      mtReader: begin
        // We should get the same info we got in the greeting
        // result but we set mode to reader anyway since the
        // server may want to do some internal reconfiguration
        // if it knows that a reader has connected
        SendCmd('MODE READER'); {do not localize}
        if LastCmdResult.NumericCode <> 200 then begin
          ModeResult := mrNoPost;
        end else begin
          ModeResult := mrCanPost;
        end;
      end;
    end;
    GetCapability;
    StartTLS;
  except
    Disconnect;
    Raise;
  end;
end;

destructor TIdNNTP.Destroy;
begin

  inherited;
end;

procedure TIdNNTP.GetCapability;
var
  i: Integer;
  s: String;
begin
  FCapabilities.Clear;
  if SendCmd('LIST EXTENSIONS') in [202, 215] then  {do not localize}
  begin
    IOHandler.Capture(FCapabilities,'.');
  end;
  //flatten everything out for easy processing
  for i := 0 to FCapabilities.Count -1 do
  begin
    s := Trim(UpperCase(FCapabilities[i]));
    FCapabilities[i] := s;
  end;
  FOVERSupported := IsExtCmdSupported('OVER');  {do not localize}
  FHDRSupported := IsExtCmdSupported('HDR');  {do not localize}
//  Self.FStartTLSSupported := IsExtCmdSupported('STARTTLS');
end;

function TIdNNTP.IsExtCmdSupported(AExtension: String): Boolean;
begin
  Result := FCapabilities.IndexOf(Trim(UpperCase(AExtension)))>-1;
end;

procedure TIdNNTP.StartTLS;
var LIO : TIdSSLIOHandlerSocketBase;
begin

  if (IOHandler is TIdSSLIOHandlerSocketBase) and (FUseTLS<>utNoTLSSupport) then
  begin
    LIO := TIdSSLIOHandlerSocketBase(IOHandler);
    //we check passthrough because we can either be using TLS currently with
    //implicit TLS support or because STARTLS was issued previously.
    if LIO.PassThrough then
    begin
      if Self.IsExtCmdSupported('STARTTLS') then  {do not localize}
      begin
        if SendCmd('STARTTLS')=382 then {do not localize}
        begin
          Self.TLSHandshake;
          AfterConnect;
        end
        else
        begin
          ProcessTLSNegCmdFailed;
        end;
      end
      else
      begin
        ProcessTLSNotAvail;
      end;
    end;
  end;
end;

function TIdNNTP.GetSupportsTLS: boolean;
begin
  Result := IsExtCmdSupported('STARTTLS') {do not localize}
end;

procedure TIdNNTP.XHDR(AHeader, AParam: string);
var LLine : String;
  LMsg, LHeaderData : String;
  LCanContinue : Boolean;
begin
  if Assigned(FOnXHDREntry) then
  begin
    XHDRCommon(AHeader,AParam);
    BeginWork(wmRead, 0);
    try
      LLine := IOHandler.ReadLn;
      LCanContinue := True;
      while (LLine <> '.') and LCanContinue do
      begin
        ParseXHDRLine(LLine,LMsg,LHeaderData);
        FOnXHDREntry(AHeader,LMsg,LHeaderData,LCanContinue);
        LLine := IOHandler.ReadLn;
      end;
    finally
      EndWork(wmRead);
    end;
  end
  else
  begin
    raise EIdNNTPNoOnXHDREntry.Create(RSNNTPNoOnXHDREntry);
  end;
end;

procedure TIdNNTP.XOVER(AParam: string);
var
  LLine : String;
  //for our XOVER data
  LArticleIndex : Integer;
  LSubject,
  LFrom : String;
  LDate : TDateTime;
  LMsgId, LReferences : String;
  LByteCount,
  LLineCount : Integer;
  LExtraData : String;
  LCanContinue : Boolean;
begin
  if Assigned( FOnXOVER) then
  begin
    XOVERCommon(AParam);
    BeginWork(wmRead, 0);
    try
      LLine := IOHandler.ReadLn;
      LCanContinue := True;
      while (LLine <> '.') and LCanContinue do
      begin
        ParseXOVER(LLine,LArticleIndex,LSubject,LFrom,LDate,
          LMsgId,LReferences,LByteCount,LLineCount,LExtraData);
        FOnXOVER(LArticleIndex,LSubject,LFrom,LDate,LMsgId,LReferences,LByteCount,LLineCount,LExtraData,LCanContinue);
        LLine := IOHandler.ReadLn;
      end;
    finally
      EndWork(wmRead);
    end;
  end
  else
  begin
    raise EIdNNTPNoOnXOVER.Create(RSNNTPNoOnXOVER);
  end;
end;

procedure TIdNNTP.ParseXHDRLine(ALine: String; out AMsg,
  AHeaderData: String);
begin
//from:  RFC 2890
//Each line
//containing matched headers returned by the server has an article
//number (or message ID, if a message ID was specified in the command),
//then one or more spaces, then the value of the requested header in
//that article.

//from: http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-18.txt
// describing HDR
// The line consists
//   of the article number, a space, and then the contents of the header
//   (without the header name or the colon and space that follow it) or
//   metadata item. If the article is specified by message-id rather than
//   by article range, the article number is given as "0".
  AMsg := Fetch(ALine);
  AHeaderData := ALine;
end;

procedure TIdNNTP.XHDRCommon(AHeader, AParam : String);
begin
  if FHDRSupported then
  begin
  //http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-18.txt
  //says the correct reply code is 225 but RFC 2980 specifies 221 for the
  //XHDR command so we should accept both to CYA.
    SendCmd('HDR '+ AHeader + ' ' + AParam, [225, 221]);  {do not localize}
  end
  else
  begin
    SendCmd('XHDR ' + AHeader + ' ' + AParam, 221); {do not localize}
  end;
end;

procedure TIdNNTP.XOVERCommon(AParam: String);
begin
  if FOVERSupported then begin
    SendCmd('OVER '+ AParam, 224);  {do not localize}
  end else begin
    SendCmd('XOVER ' + AParam, 224);  {do not localize}
  end;
end;

procedure TIdNNTP.DisconnectNotifyPeer;
begin
  inherited;
  SendCmd('Quit', 205);  {do not localize}
end;

end.