idimap4.pas

Indy控件的使用源代码

   IMAP4StatusDataItem : array [mdMessages..mdUnseen] of String =
   ( 'MESSAGES', {Do not Localize}
     'RECENT', {Do not Localize}
     'UIDNEXT', {Do not Localize}
     'UIDVALIDITY', {Do not Localize}
     'UNSEEN' ); {Do not Localize}

{ TIdImapMessageParts }

function TIdImapMessageParts.GetItem(Index: Integer): TIdImapMessagePart;
begin
  Result := TIdImapMessagePart(inherited GetItem(Index));
end;

function TIdImapMessageParts.Add: TIdImapMessagePart;
begin
  Result := TIdImapMessagePart(inherited Add);
end;

procedure TIdImapMessageParts.SetItem(Index: Integer; const Value: TIdImapMessagePart);
begin
  inherited SetItem(Index, Value);
end;

{ TIdIMAP4 }

function TIdIMAP4.IsNumberValid(const ANumber: Integer): Boolean;
    {CC3: Need to validate message numbers (relative and UIDs), because otherwise
    the routines wait for a response that never arrives and so functions never return.}
begin
    if ANumber < 1 then begin
        raise EIdNumberInvalid.Create('Number passed as parameter is invalid, must be 1 or greater');
    end;
    Result := True;
end;

function TIdIMAP4.IsUIDValid(const AUID: string): Boolean;
    {CC3: Need to validate message numbers (relative and UIDs), because otherwise
    the routines wait for a response that never arrives and so functions never return.}
var
    LN: integer;
begin
    if AUID = '' then begin
        raise EIdNumberInvalid.Create('Empty string passed as UID');
    end;
    for LN := 1 to length(AUID) do begin
        if ( (Ord(AUID[LN]) < Ord('0')) or (Ord(AUID[LN]) > Ord('9')) ) then begin
            raise EIdNumberInvalid.Create('UID passed as parameter is invalid, contains non-digit');
        end;
    end;
    if StrToInt(AUID) < 1 then begin
        raise EIdNumberInvalid.Create('UID passed as parameter is invalid, must be 1 or greater');
    end;
    Result := True;
end;

function  TIdIMAP4.GetUID(const AMsgNum: Integer; var AUID: string): Boolean;
{This gets the message UID from the message relative number.  Based on the code
in "function TIdIMAP4.CheckMsgSeen(const AMsgNum: Integer): Boolean;"}
var
  Ln : Integer;
  LSlRetrieve : TStringList;
begin
  Result := False;
  AUID := '';
  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 {Do not Localize}
            begin
              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
{$IFDEF INDY100}
        IOHandler.WriteLn(AOut);
{$ELSE}
        inherited WriteLn(AOut);
{$ENDIF}
end;

function  TIdIMAP4.ReadLnWait: string;
var sLine: string;
begin
{$IFDEF INDY100}
        sLine := inherited IOHandler.ReadLnWait;    {This can have hit an exception of Connection Reset By Peer (timeout)}
{$ELSE}
        sLine := inherited ReadLnWait;    {This can have hit an exception of Connection Reset By Peer (timeout)}
{$ENDIF}
    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;
{$IFDEF INDY100}
  case PosInStrarray(LastCmdResult.Code,VALID_UNTAGGEDREPLIES) of
{$ELSE}
  case PosInStrarray(LastCmdResult.TextCode,VALID_UNTAGGEDREPLIES) of
{$ENDIF}
      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 {Do not Localize} //Untagged response
        begin // Multi line response coming
             {We keep reading lines until we encounter either a line such as "250" or "250 Read"}
             repeat
                   LLine := ReadLnWait;
                   LResponse.Add(LLine);
             until ( AnsiSameText (Copy (LLine, 1, Length (ATag)), ATag) );
        end;
        {FLastCmdResult.ParseResponse(ATag, LResponse);}
        ParseResponse(ATag, LResponse);
     finally
            FreeAndNil (LResponse);
     end;
end;

procedure TIdIMAP4.GetInternalResponse;
var LLine: String;
    LResponse: TStringList;
begin
     LResponse := TStringList.Create;
     try
        LLine := ReadLnWait;
        LResponse.Add(LLine);
        {FLastCmdResult.ParseResponse(LResponse);}
{$IFDEF INDY100}
        //SetFormattedReply(LResponse);
        FLastCmdResult.FormattedReply := LResponse;
{$ELSE}
        ParseResponse(LResponse);
{$ENDIF}
     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 {Do not Localize} //Untagged response
        begin
        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;
        {FLastCmdResult.ParseLineResponse(ATag, LResponse);}
        ParseLineResponse(ATag, LResponse);
     finally
            FreeAndNil (LResponse);
     end;
end;

{$IFDEF INDY100}
function TIdIMAP4.SendCmd(const AOut: string; const AResponse: Array of SmallInt): SmallInt;
begin
  Result := SendCmd(NewCmdCounter,AOut,AResponse);
end;
{$ENDIF}

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
                 FConnectionState := csUnexpectedlyDisconnected;
                 raise;
             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;

{$IFDEF INDY100}
procedure TIdIMAP4.Login;
begin
  try
    if UseTLS in ExplicitTLSVals then begin