idimap4.pas

indy的原文件哈!大家可以下来参考和学习之用.也可以用以作组件.开发其他的应用程序.

  Ln : Integer;
  LSlRetrieve : TStringList;
begin
    Result := False;
    AUID := '';  {Do not Localize}
    IsNumberValid(AMsgNum);

    if (FConnectionState = csSelected) then begin
        {Some servers return NO if the requested message number is not present
        (e.g. Cyrus), others return OK but no data (CommuniGate).}
        SendCmd(NewCmdCounter, (IMAP4Commands[cmdFetch] + ' ' + IntToStr(AMsgNum) + {Do not Localize}
          ' (' + IMAP4FetchDataItem[fdUID] + ')' ), [wsOk,wsNO]);                   {Do not Localize}
        if (LastCmdResult.NumericCode = wsOk) then begin
            for Ln := 0 to (LastCmdResult.Text.Count - 1) do begin
                LSlRetrieve := TStringList.Create;
                try
                    BreakApart(LastCmdResult.Text[Ln], ' ', LSlRetrieve);           {Do not Localize}
                    if LSlRetrieve.Count > 3 then begin
                        if (AnsiSameText(LSlRetrieve[0], IntToStr(AMsgNum)) and
                          AnsiSameText(LSlRetrieve[1], IMAP4Commands[cmdFetch]) and
                          AnsiSameText(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdUID])) then begin {Do not Localize}
                            Result := True;
                            AUID := Copy(LSlRetrieve[3], 1, Pos(')', LSlRetrieve[3])-1); {Do not Localize}
                        end;
                    end;
                finally
                    LSlRetrieve.Free;
                end;
            end;
        end;
    end else begin
        raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName]);
    end;
end;


procedure TIdIMAP4.WriteLn(AOut: string);
begin
        inherited WriteLn(AOut);
end;

function  TIdIMAP4.ReadLnWait: string;
var sLine: string;
begin
        sLine := inherited ReadLnWait;    {This can have hit an exception of Connection Reset By Peer (timeout)}
    Result := sLine;
end;

{ IdTCPConnection Commands... }


function TIdIMAP4.GetResponse(const ATag: String; const AAllowedResponses: array of SmallInt): SmallInt;
begin
    GetInternalResponse (ATag);
    TaggedReplyConvertToConst;
    Result := CheckResponse(LastCmdResult.NumericCode, AAllowedResponses);
end;

function TIdIMAP4.GetResponse(const AAllowedResponses: array of SmallInt): SmallInt;
begin
    GetInternalResponse;
    {CC7: Following moved to IdReplyIMAP4...}
  {  case PosInStrarray(LastCmdResult.Code,VALID_UNTAGGEDREPLIES) of
        0 : LastCmdResult.NumericCode := wsOK;      {* OK}
  {      1 : LastCmdResult.NumericCode := wsNo;      {* NO}
  {      2 : LastCmdResult.NumericCode := wsBAD;     {* BAD}
  {      3 : LastCmdResult.NumericCode := wsPreAuth; {* PREAUTH}
  {      4 : LastCmdResult.NumericCode := wsBYE;     {* BYE}
  {      5 : LastCmdResult.NumericCode := wsContinue;{* +}
  {    else
  {      raise EIdException.Create(RSUnrecognizedIMAP4ResponseHeader);
    end;
  }
    {Result := CompareResponse2(LastCmdResult.Code, ['OK', '+']);}
  //  Result := LastCmdResult.NumericCode;
    case PosInStrarray(LastCmdResult.TextCode,VALID_UNTAGGEDREPLIES) of
        0 : LastCmdResult.NumericCode := wsOK;      {* OK}
        1 : LastCmdResult.NumericCode := wsNo;      {* NO}
        2 : LastCmdResult.NumericCode := wsBAD;     {* BAD}
        3 : LastCmdResult.NumericCode := wsPreAuth; {* PREAUTH}
        4 : LastCmdResult.NumericCode := wsBYE;     {* BYE}
        5 : LastCmdResult.NumericCode := wsContinue;{* +}
      else
        raise EIdException.Create(RSUnrecognizedIMAP4ResponseHeader);
    end;
    Result := CheckResponse(LastCmdResult.NumericCode, AAllowedResponses);
end;


function TIdIMAP4.GetLineResponse(const ATag: String; const AAllowedResponses: array of SmallInt): SmallInt;
begin
    GetInternalLineResponse (ATag);
    TaggedReplyConvertToConst;
    Result := CheckResponse(LastCmdResult.NumericCode, AAllowedResponses);
end;

procedure TIdIMAP4.GetInternalResponse (const ATag: String);
var LLine: String;
    LResponse: TStringList;
begin
    LResponse := TStringList.Create;
    try
        LLine := ReadLnWait;
        LResponse.Add(LLine);
        if ( LLine[1] = '*' ) then begin {Do not Localize} //Untagged response
            // Multi line response coming
            repeat
                LLine := ReadLnWait;
                LResponse.Add(LLine);
            until ( AnsiSameText (Copy (LLine, 1, Length (ATag)), ATag) );
        end;
        ParseResponse(ATag, LResponse);
        RemoveAnyAdditionalResponses;
    finally
        FreeAndNil (LResponse);
    end;
end;

procedure TIdIMAP4.GetInternalResponse;
var LLine: String;
    LResponse: TStringList;
begin
    LResponse := TStringList.Create;
    try
        LLine := ReadLnWait;
        LResponse.Add(LLine);
        ParseResponse(LResponse);
        RemoveAnyAdditionalResponses;
    finally
        FreeAndNil (LResponse);
    end;
end;

procedure TIdIMAP4.GetInternalLineResponse (const ATag: String);
var LLine: String;
    LResponse: TStringList;
begin
    LResponse := TStringList.Create;
    try
        LLine := ReadLnWait;
        LResponse.Add(LLine);
        if ( LLine[1] = '*' ) then begin {Do not Localize} //Untagged response
        end else begin // Maybe multi line response coming
            while not AnsiSameText (Copy (LLine, 1, Length (ATag)), ATag) do begin
                LLine := ReadLnWait;
                LResponse.Add(LLine);
            end;
        end;
        ParseLineResponse(ATag, LResponse);
        RemoveAnyAdditionalResponses;
    finally
        FreeAndNil (LResponse);
    end;
end;

procedure TIdIMAP4.RemoveAnyAdditionalResponses;
{CC8: Try to clean out any additional responses sent AFTER the result code,
e.g. a line like "* BAD parameter" after "C41 BAD" or whatever...}
var LLine: string;
    nChars: integer;
begin
    Exit;  {Does not work}
    nChars := InputBuffer.Size;
    while nChars > 0 {IOHandler.InternalBufferIsEmpty = False} do begin
        LLine := ReadLnWait;
        nChars := InputBuffer.Size;
    end;
end;


function TIdIMAP4.SendCmd(const ATag, AOut: string; const AResponse: array of SmallInt): SmallInt;
begin
    if ( AOut <> #0 ) then begin
        {CC3: Catch "Connection reset by peer"...}
        try
            WriteLn ( ATag + ' ' + AOut ); {Do not Localize}
        except
            //on E: Exception do begin
            on e:EIdSocketError do begin
                if e.LastError = 10054 then begin
                    //Connection reset by peer...
                    FConnectionState := csUnexpectedlyDisconnected;
                    raise;
                end;
            end;
        end;
    end;
    Result := GetResponse ( ATag, AResponse );
end;

function TIdIMAP4.SendCmd(const ATag, AOut: string; const AResponse: SmallInt): SmallInt;
begin
    if ( AResponse = -1 ) then begin
        result := SendCmd ( ATag, AOut, [] );
    end else begin
        result := SendCmd ( ATag, AOut, [AResponse] );
    end;
end;

{ ...IdTCPConnection Commands }

procedure TIdIMAP4.DoAlert(const AMsg: String);
begin
    if Assigned(OnAlert) then begin
        OnAlert(Self, AMsg);
    end;
end;

procedure TIdIMAP4.SetMailBox(const Value: TIdMailBox);
begin
    FMailBox.Assign(Value);
end;

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;
            if Password <> '' then begin  {Do not Localize}
                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;