idimap4.pas

Indy控件的使用源代码

    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;

{$IFDEF INDY100}
  TIdIMAP4 = class(TIdMessageSASLClient)
{$ELSE}
  TIdIMAP4 = class(TIdMessageClient)
{$ENDIF}
  private
    procedure SetMailBox(const Value: TIdMailBox);
  protected
    FCmdCounter : Integer;
    FConnectionState : TIdIMAP4ConnectionState;
    FMailBox : TIdMailBox;
    FMailBoxSeparator: Char;
    FOnAlert: TIdAlertEvent;
    FRetrieveOnSelect: TIdRetrieveOnSelect;
{$IFDEF INDY100}
    FHasCapa : Boolean;
    FGreetingCode : SmallInt;
    //This override is necessary because SASL requires some special treatment in IMAP4
    //due to syntax differences.
    //CC6: Now moved in Indy 10 changes...
    //function LoginSASL(const ACmd: String; const AOkReplies, AContinueRplies: array of SmallInt): Boolean; override;
    //Note that this is found with the CAPA command
{$ENDIF}
    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;
//{$IFNDEF INDY100}
    procedure StripCRLFs(var AText: string);
//{$ENDIF}
  { 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...}
    procedure ParseBodyStructurePart(APartString: string; AThePart: TIdMessagePart; AImapPart: TIdImapMessagePart);
    procedure BreakApartParamsInQuotes(const AParam: string; var AParsedList: TStringList);
    function  GetNextQuotedParam(AParam: string): string;
    procedure ParseExpungeResult (AMB: TIdMailBox; CmdResultDetails: TStrings);
    procedure ParseListResult (AMBList: TStringList; CmdResultDetails: TStrings);
    procedure ParseLSubResult(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);
  { Parser Functions }
    {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 = '';
      AEncoding: string = 'text'): Boolean;
    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;
    {CC3: Following added for TLS support..}
    function IsCapabilityListed(ACapability: string):Boolean;
    {CC6: Added to support RetrieveEnvelopeRaw...}
    function InternalRetrieveEnvelope(const AMsgNum: Integer; AMsg: TIdMessage; ADestList: TStringList): Boolean;
    {CC6: Added to support UIDRetrieveEnvelopeRaw...}
    function UIDInternalRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage; ADestList: TStringList): 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.}
    function IsNumberValid(const ANumber: Integer): Boolean;
    function IsUIDValid(const AUID: string): Boolean;
    {CC6: Override IdMessageClient's ReceiveBody due to the responses from some
    servers...}
    procedure ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); override;
{$IFDEF INDY100}
    {The following is for INTERNAL use...}
    function Capability: Boolean; overload;
{$ENDIF}
  public
  { TIdIMAP4 Commands }
{$IFDEF INDY100}
    //Requests a listing of capabilities that the server supports.
    function Capability(ASlCapability: TStrings): Boolean; overload;
{$ELSE}
    //Requests a listing of capabilities that the server supports.
    function Capability (ASlCapability: TStrings): Boolean;
{$ENDIF}
    procedure DoAlert (const AMsg: String);
    property ConnectionState: TIdIMAP4ConnectionState read FConnectionState;
    property MailBox: TIdMailBox read FMailBox write SetMailBox;
    function AppendMsg (const AMBName: String; AMsg: TIdMessage;
      const AFlags: TIdMessageFlagsSet = []): Boolean;
    //Requests a checkpoint of the currently selected mailbox.
    function CheckMailBox: Boolean;
    //Checks if the message was read or not.
    function CheckMsgSeen (const AMsgNum: Integer): Boolean;
{$IFDEF INDY100}
    //Method for logging in manually if you didn't login at connect
    procedure Login; virtual;
    //Connects and logins to the IMAP4 account.
    procedure Connect(const AAndLogin: boolean = true); reintroduce; virtual;
{$ELSE}
    //Connects and logins to the IMAP4 account.
    procedure Connect(const ATimeout: Integer = IdTimeoutDefault); override;
{$ENDIF}
    //Close's the current selected mailbox in the account.    {Do not Localize}
    function CloseMailBox: Boolean;
    constructor Create(AOwner: TComponent); override;
    //Create's a new mailbox with the specified name in the account.    {Do not Localize}
    function CreateMailBox (const AMBName: String): Boolean;
    //Delete's the specified mailbox from the account.    {Do not Localize}
    function DeleteMailBox (const AMBName: String): Boolean;
    //Marks a message for deletion, it will be deleted when the mailbox will be purged.
    function DeleteMsgs(const AMsgNumList: array of Integer): Boolean;
    destructor Destroy; override;
    //Logouts and disconnects from the IMAP account.
{$IFDEF INDY100}
    procedure Disconnect; overload; override;
    //Disconnect with a parameter for raising a Not Connected exception
    procedure Disconnect(const ARaiseExceptionIfNotCon : Boolean); reintroduce; overload;
{$ELSE}
    procedure Disconnect; override;
{$ENDIF}
    //Examine's the specified mailbox and inserts the results to the TIdMailBox provided.    {Do not Localize}
    function ExamineMailBox (const AMBName: String; AMB: TIdMailBox): Boolean;
    //Expunge's (deletes the marked files) the current selected mailbox in the account.    {Do not Localize}
    function ExpungeMailBox: Boolean;
    //Sends a NOOP (No Operation) to keep the account connection with the server alive.
    procedure KeepAlive;
    //Returns a list of all the child mailboxes (one level down) to the mailbox supplied.
    //This should be used when you fear that there are to many mailboxes and the listing of
    //all of them could be time consuming, so this should be used to retrieve specific mailboxes.
    function ListInferiorMailBoxes (AMailBoxList, AInferiorMailBoxList: TStringList): Boolean;
    //Returns a list of all the mailboxes in the user account.
    function ListMailBoxes (AMailBoxList: TStringList): Boolean;
    //Returns a list of all the subscribed mailboxes in the user account.
    function ListSubscribedMailBoxes (AMailBoxList: TStringList): Boolean;
    //Rename's the specified mailbox in the account.    {Do not Localize}
    function RenameMailBox (const AOldMBName, ANewMBName: String): Boolean;
    //Searches the current selected mailbox for messages matching the SearchRec and
    //returnes the results to the mailbox SearchResults array.
    function SearchMailBox (const ASearchInfo: array of TIdIMAP4SearchRec{Array}): Boolean;//array of TIdIMAP4SearchRec ) : Boolean;
    //Select's the current a mailbox in the account.    {Do not Localize}
    function SelectMailBox (const AMBName: String): Boolean;
    //Retrieves the status of the indicated mailbox.
    {CC2: It is pointless calling StatusMailBox with AStatusDataItems set to []
    because you are asking the IMAP server to update none of the status flags.
    Instead, if called with no AStatusDataItems specified, use the standard flags
    returned by SelectMailBox, which allows the user to easily check if the mailbox
    has changed.  Overload the functions, since AStatusDataItems cannot be set
    to nil.}
    function StatusMailBox (const AMBName: String; AMB: TIdMailBox): Boolean; overload;
    function StatusMailBox (const AMBName: String; AMB: TIdMailBox;
      const AStatusDataItems: array of TIdIMAP4StatusDataItem): Boolean; overload;
    //Changes (adds or removes) message flags.
    function StoreFlags (const AMsgNumList: array of Integer;
      const AStoreMethod: TIdIMAP4StoreDataItem;
      const AFlags: TIdMessageFlagsSet): Boolean;
    //Adds the specified mailbox name to the server's set of "active" or "subscribed"    {Do not Localize}
    //mailboxes as returned by the LSUB command.
    function SubscribeMailBox (const AMBName: String): Boolean;
    //Copy's a message from the current selected mailbox to the specified mailbox.    {Do not Localize}
    function CopyMsgs (const AMsgNumList: array of Integer; const AMBName: String): Boolean;
    //Retrieves a whole message while marking it read.
    function Retrieve (const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
    //Retrieves all envelope of the selected mailbox to the specified TIdMessageCollection.
    function RetrieveAllEnvelopes (AMsgList: TIdMessageCollection): Boolean;
    //Retrieves all headers of the selected mailbox to the specified TIdMessageCollection.
    function RetrieveAllHeaders (AMsgList: TIdMessageCollection): Boolean;
    //Retrieves all messages of the selected mailbox to the specified TIdMessageCollection.
    function RetrieveAllMsgs (AMsgList: TIdMessageCollection): Boolean;
    //Retrieves the message envelope, parses it, and discards the envelope.
    function RetrieveEnvelope (const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
    //Retrieves the message envelope into a TStringList but does NOT parse it.
    function RetrieveEnvelopeRaw(const AMsgNum: Integer; ADestList: TStringList): Boolean;
    //Returnes the message flag values.
    {CC: use "var" to get results returned}
    {function RetrieveFlags (const AMsgNum: Integer; AFlags: TIdMessageFlagsSet): Boolean;}
    function RetrieveFlags (const AMsgNum: Integer; var AFlags: TIdMessageFlagsSet): Boolean;
    {CC2: Following added for retrieving individual parts of a message...}
    function InternalRetrieveStructure(const AMsgNum: Integer; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
    //Retrieve only the message structure (this tells you what parts are in the message).
    function RetrieveStructure(const AMsgNum: Integer; AMsg: TIdMessage): Boolean; overload;
    function RetrieveStructure(const AMsgNum: Integer; AParts: TIdImapMessageParts): Boolean; overload;
    {CC2: Following added for retrieving individual parts of a message...}
    {Retrieve a specific individual part of a message}
    function RetrievePart(const AMsgNum: Integer; const APartNum: Integer;
      var ABuffer: PChar; var ABufferLength: Integer; AEncoding: string = 'text'): Boolean;
    {CC2: Following added for retrieving individual parts of a message...}
    {Retrieve a specific individual part of a message}
    function RetrievePartPeek(const AMsgNum: Integer; const APartNum: Integer;
      var ABuffer: PChar; var ABufferLength: Integer; AEncoding: string = 'text'): Boolean;
    {CC2: Following added for retrieving individual parts of a message...}
    {Retrieve a specific individual part of a message}
    function RetrievePartToFile(const AMsgNum: Integer; const APartNum: Integer;
      ALength: Integer; ADestFileNameAndPath: string; AEncoding: string): Boolean;
    {CC2: Following added for retrieving individual parts of a message...}
    {Retrieve a specific individual part of a message}
    function RetrievePartToFilePeek(const AMsgNum: Integer; const APartNum: Integer;