idimap4.pas

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

    wsNo  = 2;
    wsBad = 3;
    wsPreAuth = 4;
    wsBye = 5;
    {CC4: For consistency, change wsSASLContinue to wsContinue..}
    {wsSASLContinue = 10;}
    wsContinue = 6;


{CC6: Moved to IdReplyIMAP4 for Indy 10...}
const
    VALID_TAGGEDREPLIES : array [0..5] of string =
      ('OK',    'NO',  'BAD',  'PREAUTH',  'BYE',  '+');  {Do not Localize}
    VALID_UNTAGGEDREPLIES : array [0..5] of string =
      ('* OK','* NO','* BAD','* PREAUTH','* BYE','* +');  {Do not Localize}

{CC7: TIdImapSubSection added for multisection parts - see TIdImapMessagePart
comment for explanation}
type
TIdImapSubSection = class(TObject)
  protected
    FBodyType: string;
    FBodySubType: string;
    FFileName: string;
    FDescription: string;
    FEncoding: string;
    FSize: integer;
    FSubSection: TIdImapSubSection; {Can link down to another here}
  public
    property BodyType : String read FBodyType write FBodyType;
    property BodySubType : String read FBodySubType write FBodySubType;
    property FileName : String read FFileName write FFileName;
    property Description : String read FDescription write FDescription;
    property Encoding : String read FEncoding write FEncoding;
    property Size : integer read FSize write FSize;
    property SubSection : TIdImapSubSection read FSubSection write FSubSection;
    constructor Create;
end;

{CC3: TIdImapMessagePart and TIdImapMessageParts added for retrieving
individual parts of a message via IMAP, because IMAP uses some additional
terms.
Note that (rarely) an IMAP can have two sub-"parts" in the one part -
they are sent in the one part by the server, typically a plain-text and
html version with a boundary at the start, in between, and at the end.
TIdIMAP fills in the boundary in that case, and the FSubpart holds the
info on the second part.  I call these multisection parts.}
TIdImapMessagePart = class(TCollectionItem)
  protected
    FBodyType: string;
    FBodySubType: string;
    FFileName: string;
    FDescription: string;
    FEncoding: string;
    FSize: integer;
    FUnparsedEntry: string; {Text returned from server: useful for debugging or workarounds}
    FBoundary: string; {Only used for multisection parts}
    FSubSection: TIdImapSubSection; {Second section of multisection part goes here}
  public
    property BodyType : String read FBodyType write FBodyType;
    property BodySubType : String read FBodySubType write FBodySubType;
    property FileName : String read FFileName write FFileName;
    property Description : String read FDescription write FDescription;
    property Encoding : String read FEncoding write FEncoding;
    property Size : integer read FSize write FSize;
    property UnparsedEntry : string read FUnparsedEntry write FUnparsedEntry;
    property Boundary : string read FBoundary write FBoundary;
    property SubSection : TIdImapSubSection read FSubSection write FSubSection;
    constructor Create(Collection: TCollection); override;
    destructor  Destroy; override;
end;

type
{CC3: Added for validating message number}
EIdNumberInvalid = class(Exception);

TIdImapMessageParts = class(TOwnedCollection)
  protected
    function  GetItem(Index: Integer): TIdImapMessagePart;
    procedure SetItem(Index: Integer; const Value: TIdImapMessagePart);
  public
    function  Add: TIdImapMessagePart;
    property  Items[Index: Integer]: TIdImapMessagePart read GetItem write SetItem; default;
end;

type
  TIdIMAP4Commands =
  ( cmdCAPABILITY,
    cmdNOOP,
    cmdLOGOUT,
    cmdAUTHENTICATE,
    cmdLOGIN,
    cmdSELECT,
    cmdEXAMINE,
    cmdCREATE,
    cmdDELETE,
    cmdRENAME,
    cmdSUBSCRIBE,
    cmdUNSUBSCRIBE,
    cmdLIST,
    cmdLSUB,
    cmdSTATUS,
    cmdAPPEND,
    cmdCHECK,
    cmdCLOSE,
    cmdEXPUNGE,
    cmdSEARCH,
    cmdFETCH,
    cmdSTORE,
    cmdCOPY,
    cmdUID,
    cmdXCmd );

  {CC3: Add csUnexpectedlyDisconnected for when we receive "Connection reset by peer"}
  TIdIMAP4ConnectionState = ( csAny, csNonAuthenticated, csAuthenticated, csSelected , csUnexpectedlyDisconnected );
  {****************************************************************************
  Universal commands CAPABILITY, NOOP, and LOGOUT
  Authenticated state commands SELECT, EXAMINE, CREATE, DELETE, RENAME,
  SUBSCRIBE, UNSUBSCRIBE, LIST, LSUB, STATUS, and APPEND
  Selected state commands CHECK, CLOSE, EXPUNGE, SEARCH, FETCH, STORE, COPY, and UID
  *****************************************************************************}

  TIdIMAP4SearchKey =
  ( skAll,       //All messages in the mailbox; the default initial key for ANDing.
    skAnswered,  //Messages with the \Answered flag set.
    skBcc,       //Messages that contain the specified string in the envelope structure's BCC field.    {Do not Localize}
    skBefore,    //Messages whose internal date is earlier than the specified date.
    skBody,      //Messages that contain the specified string in the body of the message.
    skCc,        //Messages that contain the specified string in the envelope structure's CC field.    {Do not Localize}
    skDeleted,   //Messages with the \Deleted flag set.
    skDraft,     //Messages with the \Draft flag set.
    skFlagged,   //Messages with the \Flagged flag set.
    skFrom,      //Messages that contain the specified string in the envelope structure's FROM field.    {Do not Localize}
    skHeader,    //Messages that have a header with the specified field-name (as defined in [RFC-822])
                 //and that contains the specified string in the [RFC-822] field-body.
    skKeyword,   //Messages with the specified keyword set.
    skLarger,    //Messages with an [RFC-822] size larger than the specified number of octets.
    skNew,       //Messages that have the \Recent flag set but not the \Seen flag.
                 //This is functionally equivalent to "(RECENT UNSEEN)".
    skNot,       //Messages that do not match the specified search key.
    skOld,       //Messages that do not have the \Recent flag set. This is functionally
                 //equivalent to "NOT RECENT" (as opposed to "NOT NEW").
    skOn,        //Messages whose internal date is within the specified date.
    skOr,        //Messages that match either search key.
    skRecent,    //Messages that have the \Recent flag set.
    skSeen,      //Messages that have the \Seen flag set.
    skSentBefore,//Messages whose [RFC-822] Date: header is earlier than the specified date.
    skSentOn,    //Messages whose [RFC-822] Date: header is within the specified date.
    skSentSince, //Messages whose [RFC-822] Date: header is within or later than the specified date.
    skSince,     //Messages whose internal date is within or later than the specified date.
    skSmaller,   //Messages with an [RFC-822] size smaller than the specified number of octets.
    skSubject,   //Messages that contain the specified string in the envelope structure's SUBJECT field.    {Do not Localize}
    skText,      //Messages that contain the specified string in the header or body of the message.
    skTo,        //Messages that contain the specified string in the envelope structure's TO field.    {Do not Localize}
    skUID,       //Messages with unique identifiers corresponding to the specified unique identifier set.
    skUnanswered,//Messages that do not have the \Answered flag set.
    skUndeleted, //Messages that do not have the \Deleted flag set.
    skUndraft,   //Messages that do not have the \Draft flag set.
    skUnflagged, //Messages that do not have the \Flagged flag set.
    skUnKeyWord, //Messages that do not have the specified keyword set.
    skUnseen );

  TIdIMAP4SearchKeyArray = array of TIdIMAP4SearchKey;

  TIdIMAP4SearchRec = record
    Date: TDateTime;
    Size: Integer;
    Text: String;
    SearchKey : TIdIMAP4SearchKey;
  end;

  TIdIMAP4SearchRecArray = array of TIdIMAP4SearchRec;

  TIdIMAP4StatusDataItem = ( mdMessages, mdRecent, mdUIDNext, mdUIDValidity, mdUnseen );

  TIdIMAP4StoreDataItem = ( sdReplace, sdReplaceSilent, sdAdd, sdAddSilent, sdRemove, sdRemoveSilent );

  TIdRetrieveOnSelect = ( rsDisabled, rsHeaders, rsMessages );

  TIdAlertEvent = procedure(ASender: TObject; const AAlertMsg: String) of object;

TIdIMAP4 = class(TIdMessageClient)
  private
    procedure SetMailBox(const Value: TIdMailBox);
  protected
    FCmdCounter : Integer;
    FConnectionState : TIdIMAP4ConnectionState;
    FMailBox : TIdMailBox;
    FMailBoxSeparator: Char;
    FOnAlert: TIdAlertEvent;
    FRetrieveOnSelect: TIdRetrieveOnSelect;
    procedure TaggedReplyConvertToConst;
    function GetCmdCounter: String;
    function GetConnectionStateName: String;
    function GetNewCmdCounter: String;
    property LastCmdCounter: String read GetCmdCounter;
    property NewCmdCounter: String read GetNewCmdCounter;
    { General Functions }
    function ArrayToNumberStr (const AMsgNumList: array of Integer): String;
    function MessageFlagSetToStr (const AFlags: TIdMessageFlagsSet): String;
    //This function is needed because when using the regular DateToStr with dd/MMM/yyyy
    //(which is the IMAP needed convension) may give the month as the local language
    //three letter month instead of the English month needed.
    function DateToIMAPDateStr (const ADate: TDateTime): String;
    procedure StripCRLFs(var AText: string);
    { General Functions }
    { Parser Functions }
    {CC2: ParseBodyStructureResult added to support individual part retreival...}
    procedure ParseBodyStructureResult(ABodyStructure: string; ATheParts: TIdMessageParts; AImapParts: TIdImapMessageParts);
    {CC3: ParseBodyStructurePart added to support individual part retreival...}
    {CC7: TIdImapSubSection added to ParseBodyStructurePart to support multisection parts...}
    procedure ParseBodyStructurePart(APartString: string; AThePart: TIdMessagePart; AImapPart: TIdImapMessagePart; AImapSubSection: TIdImapSubSection);
    procedure ParseTheLine(ALine: string; LPartsList: TStringList);
    procedure ParseIntoParts(APartString: string; AParams: TStringList);
    procedure ParseIntoImapParts(APartString: string; AParams: TStringList);
    procedure BreakApartParamsInQuotes(const AParam: string; var AParsedList: TStringList);
    function  GetNextWord(AParam: string): string;
    function  GetNextQuotedParam(AParam: string): string;
    procedure ParseExpungeResult (AMB: TIdMailBox; CmdResultDetails: TStrings);
    procedure ParseListResult (AMBList: TStringList; CmdResultDetails: TStrings);
    procedure ParseLSubResult(AMBList: TStringList; CmdResultDetails: TStrings);
    {CCA: InternalParseListResult added to resolve NIL mailbox separator and
    rationalise code between ParseLisTresult and ParseLSubResult}
    procedure InternalParseListResult(ACmd: string; AMBList: TStringList; CmdResultDetails: TStrings);
    procedure ParseMailBoxAttributeString(AAttributesList: String; var AAttributes: TIdMailBoxAttributesSet);
    procedure ParseMessageFlagString (AFlagsList: String; var AFlags: TIdMessageFlagsSet);
    procedure ParseSelectResult (AMB: TIdMailBox; CmdResultDetails: TStrings);
    procedure ParseStatusResult (AMB: TIdMailBox; CmdResultDetails: TStrings);
    procedure ParseSearchResult (AMB: TIdMailBox; CmdResultDetails: TStrings);
    procedure ParseEnvelopeResult (AMsg: TIdMessage; ACmdResultStr: String);
    {CC3: The following were moved up from IdRFCReply to implement the + response...}
    procedure ParseResponse(const AStrings: TStrings); overload;
    procedure ParseResponse(const ATag: String; const AStrings: TStrings); overload;
    procedure ParseLineResponse(const ATag: String; const AStrings: TStrings);
    {CC8: Following added to combine the (UID)Retrieve(Peek) functions...}
    function  InternalRetrieve(const AMsgNum: Integer; AUseUID: Boolean; AUsePeek: Boolean; AMsg: TIdMessage): Boolean;
    {CC2: Following added for retrieving individual parts of a message...}
    function  InternalRetrievePart(const AMsgNum: Integer; const APartNum: Integer;
      AUseUID: Boolean; AUsePeek: Boolean;
      var ABuffer: PChar; var ABufferLength: Integer; {NOTE: var args cannot have default params}
      ADestFileNameAndPath: string = '';  {Do not Localize}
      AEncoding: string = 'text'): Boolean;  {Do not Localize}
    function  ParseBodyStructureSectionAsEquates(AParam: string): string;
    function  ParseBodyStructureSectionAsEquates2(AParam: string): string;
    {CC3: Following added for retrieving the text-only part of a message...}
    function  InternalRetrieveText(const AMsgNum: Integer; var AText: string;
      AUseUID: Boolean; AUsePeek: Boolean; AUseFirstPartInsteadOfText: Boolean): Boolean;