idimap4.pas

Indy控件的使用源代码

      if SupportsTLS then
      begin
        if SendCmd('STARTTLS') = wsOk then {Do not Localize}
        begin
          TLSHandshake;
          //obtain capabilities again - RFC2595
          Capability;
        end
        else
        begin
          ProcessTLSNegCmdFailed;
        end;
      end
      else
      begin
        ProcessTLSNotAvail;
      end;
    end;
    if ( FGreetingCode = wsOk ) then
    begin
      FConnectionState := csNonAuthenticated;
      FCmdCounter := 0;
      if Self.AuthenticationType = atUserPass then
      begin
        if Password <> '' then begin
          SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username + ' ' + Password, wsOk ); {Do not Localize}
        end else begin
          SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username, wsOk ); {Do not Localize}
        end;
        if ( LastCmdResult.NumericCode = wsOk ) then
        begin
          FConnectionState := csAuthenticated;
    //      Capability;
        end;
      end
      else
      begin
        //Self.LoginSASL('AUTHENTICATE',[wsOk],[wsContinue]);
        //CC6: Now changed due to Indy 10 changes...
        LoginSASL('AUTHENTICATE',['* OK'],['* +']);
    //    Capability;
      end;
    end
    else
    begin
      if ( LastCmdResult.NumericCode = wsPreAuth ) then
      begin
        FConnectionState := csAuthenticated;
        FCmdCounter := 0;
      end;
    end;
   Capability;
  except
    Disconnect;
    raise;
  end;
end;
procedure TIdIMAP4.Connect(const AAndLogin: boolean = true);
begin
  {CC2: Need to set FConnectionState to csNonAuthenticated here.  If not, then
  an unsuccessful connect after a previous successful connect (such as when a
  client program changes users) can leave it as csAuthenticated.}
  FConnectionState := csNonAuthenticated;
  {CC2: Don't call Connect if already connected, this could be just a change of user}
  if Connected = False then begin
    inherited Connect;
  end;
  FGreetingCode := GetResponse ( [wsOk, wsPreAuth] );
  Capability;
  if AAndLogin then begin
    Login;
  end;
end;
{$ELSE}
procedure TIdIMAP4.Connect(const ATimeout: Integer = IdTimeoutDefault);
begin
    {CC2: Need to set FConnectionState to csNonAuthenticated here.  If not, then
    an unsuccessful connect after a previous successful connect (such as when a
    client program changes users) can leave it as csAuthenticated.}
    FConnectionState := csNonAuthenticated;
    {CC2: Don't call Connect if already connected, this could be just a change of user}
    if Connected = False then begin
     inherited Connect(ATimeout);
    end;
     try
        GetResponse ( [wsOk, wsPreAuth] );
        if ( LastCmdResult.NumericCode = wsOk ) then
        begin

             FConnectionState := csNonAuthenticated;
             FCmdCounter := 0;
             {SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username + ' ' + Password, wsOk ); {Do not Localize}
             if Password <> '' then begin
                 SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username + ' ' + Password, wsOk ); {Do not Localize}
             end else begin
                 SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username, wsOk ); {Do not Localize}
             end;
             if ( LastCmdResult.NumericCode = wsOk ) then
             begin
                  FConnectionState := csAuthenticated;
             end;
        end
        else if ( LastCmdResult.NumericCode = wsPreAuth ) then
        begin
             FConnectionState := csAuthenticated;
             FCmdCounter := 0;
        end;
     except
           Disconnect;
           raise;
     end;
end;
{$ENDIF}

constructor TIdIMAP4.Create(AOwner: TComponent);
begin
{$IFDEF INDY100}
     FReplyClass := TIdReplyIMAP4;
{$ENDIF}
     inherited Create(AOwner);
     FMailBox := TIdMailBox.Create (Self);
{$IFDEF INDY100}
     FAuthenticationType := DEF_IMAP4_AUTH;
     Self.FValidAuthTypes := [atUserPass,atSASL];
{$ENDIF}
     Port := IdPORT_IMAP4;
{$IFDEF INDY100}
     //Todo:  Not sure which number is appropriate.  Should be tested
     FImplicitTLSProtPort := IdPORT_IMAP4S;  //Id_PORT_imap4_ssl_dp;
     FRegularProtPort := IdPORT_IMAP4;
{$ENDIF}
     FCmdCounter := 0;
     FConnectionState := csNonAuthenticated;
     FRetrieveOnSelect := rsDisabled;
     //TODO: May be detected automatically
     //Default in original source was '/', but Cyrus uses '.' as default    {Do not Localize}
     {CC2: FMailBoxSeparator is now detected when a mailbox is selected, following
     line is probably redundant, but leave it there just in case.}
     FMailBoxSeparator := '/';    {Do not Localize}
end;

{$IFDEF INDY100}
procedure TIdIMAP4.Disconnect(const ARaiseExceptionIfNotCon : Boolean);
begin
  //Available in any state.
  if Connected then
  begin
    try
      SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogout], wsOk );
    finally
      inherited Disconnect;
      FConnectionState := csNonAuthenticated;
    end;
    FCapabilities.Clear;
  end
  else
  begin
    if ARaiseExceptionIfNotCon then
    begin
      raise EIdClosedSocket.Create ( RSStatusDisconnected );
    end;
  end;
end;
procedure TIdIMAP4.Disconnect;
begin
  Disconnect(True);
end;
{$ELSE}
procedure TIdIMAP4.Disconnect;
begin
     //Available in any state.
     if Connected then
     begin
          try
             SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogout], wsOk );
          finally
                 inherited;
                 FConnectionState := csNonAuthenticated;
          end;
     end
     else
     begin
         raise EIdClosedSocket.Create ( RSStatusDisconnected );
     end;
end;
{$ENDIF}

procedure TIdIMAP4.KeepAlive;
begin
     //Avialable in any state.
     SendCmd ( NewCmdCounter, IMAP4Commands[cmdNoop], wsOk );
end;

function TIdIMAP4.IsCapabilityListed(ACapability: string):Boolean;
var
    LCapabilities: TStringList;
    LN: Integer;
begin
    Result := False;
    LCapabilities := TStringList.Create;
    if Capability(LCapabilities) = False then begin
        LCapabilities.Destroy;
        Exit;
    end;
    for LN := 0 to LCapabilities.Count-1 do begin
        if UpperCase(ACapability) = UpperCase(LCapabilities.Strings[LN]) then begin
            Result := True;
            LCapabilities.Destroy;
            Exit;
        end;
    end;
    LCapabilities.Destroy;
end;

{$IFDEF INDY100}
function TIdIMAP4.Capability: Boolean;
begin
  {This is for INTERNAL use}
  Result := Capability(FCapabilities);
  ParseCapaReply(FCapabilities);
end;
{$ENDIF}


function TIdIMAP4.Capability(ASlCapability: TStrings): Boolean;
{$IFDEF INDY100}
{var LTag : String;}
{$ENDIF}
begin
     //Available in any state.
{$IFDEF INDY100}
     ASlCapability.Clear;
{$ENDIF}
     Result := False;
     SendCmd ( NewCmdCounter, (IMAP4Commands[CmdCapability]), wsOk);
     if ( LastCmdResult.NumericCode = wsOk ) and Assigned (ASlCapability) then
     begin
          ASlCapability.Clear;
          BreakApart ( LastCmdResult.Text[0], ' ', ASlCapability ); {Do not Localize}
          ASlCapability.Delete(0);
          Result := True;
     end;
{$IFDEF INDY100}
     {GetResponse was used to gobble the + reply in logging in, move to login code}
     {GetResponse(LTag,[]);}
     FHasCapa := Result;
{$ENDIF}
end;

function TIdIMAP4.GetCmdCounter: String;
begin
     Result := 'C' + IntToStr ( FCmdCounter ); {Do not Localize}
end;

function TIdIMAP4.GetNewCmdCounter: String;
begin
     Inc ( FCmdCounter );
     Result := 'C' + IntToStr ( FCmdCounter ); {Do not Localize}
end;

destructor TIdIMAP4.Destroy;
begin
     {CC2: Disconnect before we die}
{$IFDEF INDY100}
     //Note we have to pass false to an overloaded method or
     //an exception is raised in the destructor.  That can cause weirdness in the IDE.
     Disconnect(False);
{$ELSE}
     Disconnect;
{$ENDIF}
     FreeAndNil(FMailBox);
     inherited;
end;

function TIdIMAP4.SelectMailBox(const AMBName: String): Boolean;
begin
    {CC2: Default to returning False at this point...}
    Result := False;
     if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then
     begin
          SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdSelect] + ' "' + AMBName + '"' ), wsOk); {Do not Localize}
          if ( LastCmdResult.NumericCode = wsOk ) then
          b