idimap4.pas

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

    52,53,54,55,56,57,58,59,60,61,-1,-1,-1,-1,-1,-1,                    //  64
    -1,00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,                    //  80
    15,16,17,18,19,20,21,22,23,24,25,-1,-1,-1,-1,-1,                    //  96
    -1,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,                    // 112
    41,42,43,44,45,46,47,48,49,50,51,-1,-1,-1,-1,-1                     // 128
  );
  b64Table : array[0..127] of integer = (
    $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, //  16
    $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, //  32
    $20,$21,$22,$23, $24,$25,$FF,$27, $28,$29,$2A,$2B, $2C,$2D,$2E,$2F, //  48
    $30,$31,$32,$33, $34,$35,$36,$37, $38,$39,$3A,$3B, $3C,$3D,$3E,$3F, //  64
    $40,$41,$42,$43, $44,$45,$46,$47, $48,$49,$4A,$4B, $4C,$4D,$4E,$4F, //  80
    $50,$51,$52,$53, $54,$55,$56,$57, $58,$59,$5A,$5B, $5C,$5D,$5E,$5F, //  96
    $60,$61,$62,$63, $64,$65,$66,$67, $68,$69,$6A,$6B, $6C,$6D,$6E,$6F, // 112
    $70,$71,$72,$73, $74,$75,$76,$77, $78,$79,$7A,$7B, $7C,$7D,$7E,$FF);// 128

type
TIdMUTF7 = class(TObject)
  public
    function Encode(aString : string):string;
    function Decode(aString : string):string;
    function Valid(aMUTF7String : string):boolean;
    function Append(const aMUTF7String, aAnsiStr : string):string;
  end;

{ TIdIMAP4 }

const
    wsOk  = 1;
    wsNo  = 2;
    wsBad = 3;
    wsPreAuth = 4;
    wsBye = 5;
    wsContinue = 6;

type
    TIdIMAP4FolderTreatment = (         //Result codes from FindHowServerCreatesFolders
      ftAllowsTopLevelCreation,         //Folders can be created at the same level as Inbox (the top level)
      ftFoldersMustBeUnderInbox,        //Folders must be created under INBOX, such as INBOX.Sent
      ftDoesNotAllowFolderCreation,     //Wont allow you create folders at top level or under Inbox (may be read-only connection)
      ftCannotTestBecauseHasNoInbox,    //Wont allow top-level creation but cannot test creation under Inbox because it does not exist
      ftCannotRetrieveAnyFolders        //No folders present for that user, cannot be determined
      );

type
    TIdIMAP4AuthenticationType = (atUserPass, atSASL);
const
    DEF_IMAP4_AUTH = atUserPass;
    IDF_DEFAULT_MS_TO_WAIT_TO_CLEAR_BUFFER = 10;

{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.}
type
TIdImapMessagePart = class(TCollectionItem)
  protected
    FBodyType: string;
    FBodySubType: string;
    FFileName: string;
    FDescription: string;
    FEncoding: TIdMessageEncoding;
    FContentTransferEncoding: string;
    FSize: integer;
    FUnparsedEntry: string; {Text returned from server: useful for debugging or workarounds}
    FBoundary: string; {Only used for multisection parts}
    FParentPart: Integer;
    FImapPartNumber: string;
  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: TIdMessageEncoding read FEncoding write FEncoding;
    property ContentTransferEncoding : String read FContentTransferEncoding write FContentTransferEncoding;
    property Size : integer read FSize write FSize;
    property UnparsedEntry : string read FUnparsedEntry write FUnparsedEntry;
    property Boundary : string read FBoundary write FBoundary;
    property ParentPart: integer read FParentPart write FParentPart;
    property ImapPartNumber: string read FImapPartNumber write FImapPartNumber;
    constructor Create(Collection: TCollection); override;
end;

type
{CC3: Added for validating message number}
EIdNumberInvalid = class(EIdException);
{CCB: Added for server disconnecting you if idle too long...}
EIdDisconnectedProbablyIdledOut = class(EIdException);

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;

{CCD: Added to parse out responses, because the order in which the responses appear
varies between servers.  A typical line that gets parsed into this is:
  * 9 FETCH (UID 1234 FLAGS (\Seen \Deleted))
}
TIdIMAPLineStruct = class(TObject)
  protected
    HasStar: Boolean;           //Line starts with a '*'
    MessageNumber: string;      //Line has a message number (after the *)
    Command: string;            //IMAP servers send back the command they are responding to, e.g. FETCH
    UID: string;                //Sometimes the UID is echoed back
    Flags: TIdMessageFlagsSet;  //Sometimes the FLAGS are echoed back
    Complete: Boolean;          //If false, line has no closing bracket (response continues on following line(s))
    ByteCount: integer;         //The value in a trailing byte count like {123}, -1 means not present
    IMAPFunction: string;       //E.g. FLAGS
    IMAPValue: string;          //E.g. '(\Seen \Deleted)'
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.
    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.
    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.
    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.
    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.
    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;
    FMilliSecsToWaitToClearBuffer: integer;
    FMUTF7: TIdMUTF7;
    FOnWorkForPart: TWorkEvent;
    FOnWorkBeginForPart: TWorkBeginEvent;
    FOnWorkEndForPart: TWorkEndEvent;
    FGreetingBanner : String;  {CC7: Added because it may help identify the server}
    FHasCapa : Boolean;
    {CC7: FSASLMechanisms and FAuthType added when LoginSASL moved from TIdMessageSASLClient to TIdSASLList...}
    FSASLMechanisms : TIdSASLEntries;
    FAuthType : TIdIMAP4AuthenticationType;
    FCapabilities: TIdStringList;
    FLineStruct: TIdIMAPLineStruct;
    function GetReplyClass:TIdReplyClass; override;
    //The following call FMUTF7 but do exception-handling on invalid strings...
    function DoMUTFEncode(aString : string):string;
    function DoMUTFDecode(aString : string):string;
    function GetCmdCounter: String;
    function GetConnectionStateName: String;