idpop3.pas

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

  S: String;
  i: Integer;
begin
  try
    if UseTLS in ExplicitTLSVals then begin
      if SupportsTLS then
      begin
        if SendCmd('STLS','') = ST_OK then {Do not translate}
        begin
          TLSHandshake;
        end
        else
        begin
          ProcessTLSNegCmdFailed;
        end;
      end
      else
      begin
        ProcessTLSNotAvail;
      end;
    end;

    case FAuthType of
    atAPOP:  //APR
      begin
        S:= FGreetingBanner;  //read the initial greeting we stored
        i:=Pos('<',S);    {Do not Localize}
        if i>0 then begin
           S:=Copy(S,i,MaxInt); //?: System.Delete(S,1,i-1);
           i:=Pos('>',S);    {Do not Localize}
           if i>0 then
           begin
             S:=Copy(S,1,i)
           end
           else begin
             S:='';    {Do not Localize}
           end;
        end//if
        else begin
          S:=''; //no time-stamp    {Do not Localize}
        end;

        if Length(S) > 0 then
        begin
          with TIdHashMessageDigest5.Create do
          try
            S:=LowerCase(TIdHash128.AsHex(HashValue(S+Password)));
          finally
            Free;
          end;//try
          SendCmd('APOP '+Username+' '+S, ST_OK);    {Do not Localize}
        end
        else begin
          raise EIdDoesNotSupportAPOP.Create(RSPOP3ServerDoNotSupportAPOP);
        end;
      end;
    atUserPass:
      begin //classic method
        SendCmd('USER ' + Username, ST_OK);    {Do not Localize}
        SendCmd('PASS ' + Password, ST_OK);    {Do not Localize}
      end;//if APOP
    atSASL:
      begin
        if Assigned(FSASLMechanisms) or ( FSASLMechanisms.Count > 1) then
        begin
          FSASLMechanisms.LoginSASL('AUTH', [ST_OK], [ST_SASLCONTINUE], Self, Self.Capabilities, 'SASL'); {do not localize}
        end
        else
        begin
          raise EIdSASLMechNeeded.Create(RSASLRequired);
        end;
      end;
  end;
  except
    Disconnect;
    raise;
  end;
end;


procedure TIdPOP3.InitComponent;
begin
  inherited;
  FAutoLogin := True;
  FSASLMechanisms := TIdSASLEntries.Create(Self);
  FRegularProtPort := IdPORT_POP3;
  FImplicitTLSProtPort := IdPORT_POP3S;
  Port := IdPORT_POP3;
  FAuthType := DEF_ATYPE;
end;

function TIdPOP3.Delete(const MsgNum: Integer): Boolean;
begin
  SendCmd('DELE ' + IntToStr(MsgNum), ST_OK);   {do not localize}
  Result := LastCmdResult.Code = ST_OK;
end;

procedure TIdPOP3.DisconnectNotifyPeer;
begin
  inherited;
  SendCmd('QUIT', ST_OK);    {do not localize}
end;

function TIdPOP3.GetReplyClass:TIdReplyClass;
begin
  result:=TIdReplyPOP3;
end;

procedure TIdPOP3.KeepAlive;
begin
  SendCmd('NOOP', ST_OK);    {Do not Localize}
end;

function TIdPOP3.Reset: Boolean;
begin
  SendCmd('RSET', '');    {Do not Localize}
  Result := LastCmdResult.Code = ST_OK;
end;

function TIdPOP3.RetrieveRaw(const MsgNum: Integer; const Dest: TIdStrings):
  boolean;
begin
  result := (SendCmd('RETR ' + IntToStr(MsgNum),'')=ST_OK);    {Do not Localize}
  if result then
  begin
    IOHandler.Capture(Dest);
    result := true;
  end;
end;

function TIdPOP3.Retrieve(const MsgNum: Integer; AMsg: TIdMessage): Boolean;
begin
  if SendCmd('RETR ' + IntToStr(MsgNum), '') = ST_OK then begin   {Do not Localize}
    AMsg.Clear;
    // This is because of a bug in Exchange? with empty messages. See comment in ReceiveHeader
    if ReceiveHeader(AMsg) = '' then begin
      // Only retreive the body if we do not already have a full RFC
      ReceiveBody(AMsg);
    end;
  end;
  // Will only hit here if ok and NO exception, or IF is not executed
  Result := LastCmdResult.Code = ST_OK;
end;

function TIdPOP3.RetrieveHeader(const MsgNum: Integer; AMsg: TIdMessage): Boolean;
begin
//  Result := False;
  AMsg.Clear;
  SendCmd('TOP ' + IntToStr(MsgNum) + ' 0', ST_OK);    {Do not Localize}
  // Only gets here if no exception is raised
  ReceiveHeader(AMsg,'.');
  Result := True;
end;

function TIdPOP3.RetrieveMailBoxSize: integer;
var
  CurrentLine: string;
begin
  // Returns the size of the mailbox. Issues a LIST command and then
  // sums up each message size. The message sizes are returned in the format
  // 1 1400 2 405 3 100 etc....
  // With this routine, we prevent the user having to call RetrieveSize for
  // each message to get the mailbox size
  Result := 0;
  try
    SendCmd('LIST', ST_OK);    {Do not Localize}
    CurrentLine := IOHandler.ReadLn;
    while (CurrentLine <> '.') and (CurrentLine <> '') do    {Do not Localize}
    begin
      // RL - ignore the message number, grab just the octets,
      // and ignore everything else that may be present
      Fetch(CurrentLine);
      Result := Result + StrToIntDef(Fetch(CurrentLine), 0);
      CurrentLine := IOHandler.ReadLn;
    end;
  except
    Result := -1;
  end;
end;

function TIdPOP3.RetrieveMsgSize(const MsgNum: Integer): Integer;
var
  s: string;
begin
  Result := -1;
  // Returns the size of the message. if an error ocurrs, returns -1.
  SendCmd('LIST ' + IntToStr(MsgNum), ST_OK);    {Do not Localize}
  s := LastCmdResult.Text[0];
  if Length(s) > 0 then begin
    // RL - ignore the message number, grab just the octets,
    // and ignore everything else that may be present
    Fetch(s);
    Result := StrToIntDef(Fetch(s), -1);
  end;
end;

function TIdPOP3.UIDL(const ADest: TIdStrings; const AMsgNum: Integer = -1): Boolean;
Begin
  if AMsgNum >= 0 then begin
    Result:=SendCmd('UIDL ' + IntToStr(AMsgNum), '') = ST_OK;    {Do not Localize}
    if Result then
    begin
      ADest.Assign(LastCmdResult.Text);
    end;
  end
  else begin
    Result:=SendCmd('UIDL','')=ST_OK;    {Do not Localize}
    if Result then
    begin
      IOHandler.Capture(ADest);
    end;
  end;
End;//TIdPOP3.GetUIDL

function TIdPOP3.Top(const AMsgNum: Integer; const ADest: TIdStrings; const AMaxLines: Integer = 0): boolean;
begin
  if AMaxLines = 0 then begin
    Result := SendCmd('TOP ' + IntToStr(AMsgNum),'') = ST_OK; {Do not Localize}
  end else begin
    Result := SendCmd('TOP ' + IntToStr(AMsgNum) + ' ' + IntToStr(AMaxLines),'') = ST_OK; {Do not Localize}
  end;
  if Result then begin
    IOHandler.Capture(ADest);
  end;
end;


destructor TIdPOP3.Destroy;
begin
  FreeAndNil( FSASLMechanisms );
  inherited;
end;

function TIdPOP3.CAPA: Boolean;
begin
  Result := SendCmd('CAPA','') = ST_OK;    {Do not Localize}
  if Result then
  begin
    IOHandler.Capture(FCapabilities);
  end;
  if FCapabilities.Count >0 then
  begin
    //dete the initial OK reply line
    FCapabilities.Delete(0);
  end;
  FHasCapa := Result;
 // ParseCapaReply(FCapabilities,'SASL');
end;

function TIdPOP3.GetPassword: String;
begin
  Result := Password;
end;

function TIdPOP3.GetUsername: String;
begin
  Result := Username;
end;

procedure TIdPOP3.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if (Operation = opRemove) then begin
    if Assigned(FSASLMechanisms) then
    begin
      FSASLMechanisms.RemoveByComp(AComponent);
    end;
  end;
  inherited Notification(AComponent,Operation);
end;

function TIdPOP3.GetSupportsTLS: Boolean;
begin
   Result := ( FCapabilities.IndexOf('STLS')>-1); //do not localize
end;

procedure TIdPOP3.Connect;
begin
  FHasCAPA := False;
  if UseTLS in ExplicitTLSVals then begin
    // TLS only enabled later in this case!
    (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := true;
  end;
  if (IOHandler is TIdSSLIOHandlerSocketBase) then begin
      case FUseTLS of
       utNoTLSSupport :
       begin
        (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := true;
       end;
       utUseImplicitTLS :
       begin
         (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := False;
       end
       else
        if FUseTLS<>utUseImplicitTLS then begin
         (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := true;
        end;
      end;
  end;
  inherited;
  GetResponse(ST_OK);
  //we preserve the initial greeting text because that is needed by APOP
  //and we call the CAPA command before the APOP command.  That could throw off
  //code using LastCmdResult.Text[0] for parsing the timestamp.
  //FGreetingBanner := LastCmdResult.Text[0];
  FGreetingBanner := LastCmdResult.Text.Strings[0];
  CAPA;
  if FAutoLogin then begin
    Login;
  end;
end;

end.