idmessage.pas

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

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10251: IdMessage.pas
{
{   Rev 1.13    6/9/04 5:38:06 PM  RLebeau
{ Updated ClearHeader() to clear the MsgId and UID properties.
{ 
{ Updated SetUseNowForDate() to support AValue being set to False
}
{
{   Rev 1.12    2/3/04 11:58:26 AM  RLebeau
{ Updated TIdMessageParts.CountParts() to use the TIdMessagePart.ContentId
{ property instead of ExtraHeaders.Values['Content-Id']
}
{
{   Rev 1.11    1/15/04 7:39:10 PM  RLebeau
{ Updated GenerateHeader() to remove support for the BBCList property
}
{
{   Rev 1.10    1/7/04 10:51:32 PM  RLebeau
{ Bug fix for various TIdMessage properties that were not previously using
{ setter methods correctly.
}
{
{   Rev 1.9    10/17/03 11:49:18 AM  RLebeau
{ Added ContentID property to TIdMessagePart
{ 
{ Updated TIdText.Assign() and TIdAttachment.Assign() to copy all available
{ header values rather than select ones.
}
{
{   Rev 1.8    9/28/03 1:29:40 PM  RLebeau
{ Updated GenerateHeader() and ProcessHeader() to support the BBCList property
}
{
{   Rev 1.7    2003.07.03 11:52:08 AM  czhower
{ DeleteTempFiles addition.
{ Fix of old property IsTempFile, changed to DeleteTempFile so as not to change
{ broken but old functionality that could otherwise cause data loss.
}
{
{   Rev 1.6    02/07/2003 7:07:14 PM  ANeillans
{ Fix AV in SaveToStream (fix was posted on Indy-Dev-Public)
}
{
    Rev 1.5    6/17/2003 2:07:08 AM  DSiders
  Modified TIdMessage.SaveToStream to call Connect / Disconnect for the message
  client.  Required due to the new Active property in TIdIOHandler.
}
{
{   Rev 1.4    2003.06.15 3:00:32 PM  czhower
{ -Fixed IdIOHandlerStream to function as originally designed and needed.
{ -Change ReadStream, WriteStream to Input/Output to be consistent with other
{ areas.
}
{
    Rev 1.3    1/27/2003 10:04:52 PM  DSiders
  Corrected error setting file stream permissions in LoadFromFile.  Bug Report
  649502.
}
{
{   Rev 1.2    27/1/2003 2:33:16 PM  SGrobety
{ Only issue X-Priority header if priority is <> mpNormal
}
{
{   Rev 1.1    09/12/2002 18:23:14  ANeillans
{ Removed X-Library Line
}
{
{   Rev 1.0    2002.11.12 10:45:26 PM  czhower
}
{//////////////////////////////////////////////////////////////////
2001-Jul-11 Hadi Hariri
  TODO: Make checks for encoding and content-type later on.
  TODO: Add TIdHTML, TIdRelated
  TODO: CountParts on the fly
  TODO: Merge Encoding and AttachmentEncoding
  TODO: Make encoding plugable
  TODO: Clean up ISO header coding
/////////////////////////////////////////////////////////////////}

unit IdMessage;

{
2002-12-09 Andrew Neillans
  Removed X-Library Line
2001-12-27 Andrew P.Rybin
  Custom InitializeISO, ExtractCharSet
2001-Oct-29 Don Siders
  Added EIdMessageCannotLoad exception.
  Added RSIdMessageCannotLoad constant.
  Added TIdMessage.LoadFromStream.
  Modified TIdMessage.LoadFromFile to call LoadFromStream.
  Added TIdMessage.SaveToStream.
  Modified TIdMessage.SaveToFile to call SaveToStream.
  Modified TIdMessage.GenerateHeader to include headers received but not used in properties.
2001-Sep-14 Andrew Neillans
  Added LoadFromFile Header only
2001-Sep-12 Johannes Berg
  Fixed upper/lowercase in uses clause for Kylix
2001-Aug-09 Allen O'Neill
  Added line to check for valid charset value before adding second ';' after content-type boundry
2001-Aug-07 Allen O'Neill
  Added SaveToFile & LoadFromFile ... Doychin fixed
2001-Jul-11 Hadi Hariri
  Added Encoding for both MIME and UU.
2000-Jul-25 Hadi Hariri
 - Added support for MBCS
2000-Jun-10 Pete Mee
 - Fixed some minor but annoying bugs.
2000-May-06 Pete Mee
 - Added coder support directly into TIdMessage.
}

{ TODO : Moved Decode/Encode out and will add later,. Maybe TIdMessageEncode, Decode?? }

{ TODO : Support any header in TMessagePart }

{ DESIGN NOTE: The TIdMessage has an fBody which should only ever be the
    raw message.  TIdMessage.fBody is only raw if TIdMessage.fIsEncoded = true

    The component parts are thus possibly made up of the following
    order of TMessagePart entries:

    MP[0] : Possible prologue text (fBoundary is '')

    MP[0 or 1 - depending on prologue existence] :
      fBoundary = boundary parameter from Content-Type

    MP[next...] : various parts with or without fBoundary = ''

    MP[MP.Count - 1] : Possible epilogue text (fBoundary is '')
    }

{ DESIGN NOTE: If TMessagePart.fIsEncoded = True, then TMessagePart.fBody
    is the encoded raw message part.  Otherwise, it is the (decoded) text.
    }

interface

uses
	Classes,
  IdBaseComponent, IdException, IdEMailAddress, IdHeaderList,
  IdCoderHeader, SysUtils;

type
  TIdMessagePriority = (mpHighest, mpHigh, mpNormal, mpLow, mpLowest);

const
  ID_MSG_NODECODE = False;
  ID_MSG_USENOWFORDATE = True;
  ID_MSG_PRIORITY = mpNormal;

type
  TOnGetMessagePartStream = procedure(AStream: TStream) of object;


  TIdMIMEBoundary = class
  protected
    FBoundaryList: TStrings;
    FNewBoundary: Boolean;

    function GetBoundary: string;
  public
    constructor Create;
    destructor Destroy; override;
    class function FindBoundary(AContentType: string): string;
    procedure Push(ABoundary: string);
    procedure Pop;
    procedure Clear;

    property Boundary: string read GetBoundary;
    property NewBoundary: Boolean read FNewBoundary write FNewBoundary;
  end;

  TIdMessageFlags =
  ( mfAnswered, //Message has been answered.
    mfFlagged, //Message is "flagged" for urgent/special attention.
    mfDeleted, //Message is "deleted" for removal by later EXPUNGE.
    mfDraft, //Message has not completed composition (marked as a draft).
    mfSeen, //Message has been read.
    mfRecent ); //Message is "recently" arrived in this mailbox.

  TIdMessageFlagsSet = set of TIdMessageFlags;

  TIdMessagePart = class(TCollectionItem)
  protected
    FBoundary: string;
    FBoundaryBegin: Boolean;
    FBoundaryEnd: Boolean;
    FContentMD5: string;
    FContentID: string;
    FContentTransfer: string;
    FContentType: string;
    FEndBoundary: string;
    FExtraHeaders: TIdHeaderList;
    FHeaders: TIdHeaderList;
    FIsEncoded: Boolean;
    FOnGetMessagePartStream: TOnGetMessagePartStream;
    FStoredPathName: TFileName;
    //
    function GetContentID: string;
    function GetContentType: string;
    function GetContentTransfer: string;
    procedure SetContentID(const AValue: string);
    procedure SetContentType(const AValue: string);
    procedure SetContentTransfer(const AValue: string);
    procedure SetExtraHeaders(const AValue: TIdHeaderList);
    procedure SetHeaders(const AValue: TIdHeaderList);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    //
    property Boundary : String read FBoundary write FBoundary;
    property BoundaryBegin : Boolean read FBoundaryBegin write FBoundaryBegin;
    property BoundaryEnd : Boolean read FBoundaryEnd write FBoundaryEnd;
    property IsEncoded : Boolean read fIsEncoded;
    property OnGetMessagePartStream: TOnGetMessagePartStream read FOnGetMessagePartStream
     write FOnGetMessagePartStream;
    property StoredPathName: TFileName read FStoredPathName write FStoredPathName;
    property Headers: TIdHeaderList read FHeaders write SetHeaders;
  published
    property ContentID: string read GetContentID write SetContentID;
    property ContentTransfer: string read GetContentTransfer write SetContentTransfer;
    property ContentType: string read GetContentType write SetContentType;
    property ExtraHeaders: TIdHeaderList read FExtraHeaders write SetExtraHeaders;
  end;

  TIdMessagePartClass = class of TIdMessagePart;

  TIdMessageParts = class;

  TIdAttachment = class(TIdMessagePart)
  protected
    FContentDisposition: string;
    FDeleteTempFile: boolean;
    FFileName: TFileName;
    //
    function GetContentDisposition: string;
    procedure SetContentDisposition(const AValue: string);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TIdMessageParts; const AFileName: TFileName = ''); reintroduce;
    destructor Destroy; override;
    procedure Encode(ADest: TStream);
    function SaveToFile(const AFileName: TFileName): Boolean;
    //
    property ContentDisposition: string read GetContentDisposition write SetContentDisposition;
    property DeleteTempFile: Boolean read FDeleteTempFile write FDeleteTempFile;
    property FileName: TFileName read FFileName write FFileName;
  end;

  TIdText = class(TIdMessagePart)
  protected
    FBody: TStrings;
    //
    procedure SetBody(const AStrs : TStrings);
  public
    constructor Create(Collection: TIdMessageParts; ABody: TStrings = nil); reintroduce;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    //
    property Body: TStrings read FBody write SetBody;
  end;

  TIdMessageParts = class(TOwnedCollection)
  protected
    FAttachmentEncoding: string;
    FAttachmentCount: integer;
    FMessageEncoderInfo: TObject;
    FRelatedPartCount: integer;
    FTextPartCount: integer;
    //
    function GetItem(Index: Integer): TIdMessagePart;
    procedure SetAttachmentEncoding(const AValue: string);
    procedure SetItem(Index: Integer; const AValue: TIdMessagePart);
  public
    function Add: TIdMessagePart;
    procedure CountParts;
    constructor Create(AOwner: TPersistent); reintroduce;
    //
    property AttachmentCount: integer read FAttachmentCount;
    property AttachmentEncoding: string read FAttachmentEncoding write SetAttachmentEncoding;
    property Items[Index: Integer]: TIdMessagePart read GetItem write SetItem; default;
    property MessageEncoderInfo: TObject read FMessageEncoderInfo;
    property RelatedPartCount: integer read FRelatedPartCount;
    property TextPartCount: integer read FTextPartCount;
  end;

  TIdMessageEncoding = (meMIME, meUU);
  TIdInitializeIsoEvent = procedure (var VTransferHeader: TTransfer; var VHeaderEncoding: Char;
    var VCharSet: string) of object;

  TIdMessage = class(TIdBaseComponent)
  protected
    FBccList: TIdEmailAddressList;
    FBody: TStrings;
    FCharSet: string;
    FCcList: TIdEmailAddressList;
    FContentType: string;
    FContentTransferEncoding: string;
    FContentDisposition: string;
    FDate: TDateTime;
    FDeleteTempFiles: Boolean;
    FIsEncoded : Boolean;
    FExtraHeaders: TIdHeaderList;
    FEncoding: TIdMessageEncoding;
    FFlags: TIdMessageFlagsSet;
    FFrom: TIdEmailAddressItem;
    FHeaders: TIdHeaderList;
    FMessageParts: TIdMessageParts;
    FMIMEBoundary: TIdMIMEBoundary;
    FMsgId: string;
    FNewsGroups: TStrings;
    FNoEncode: Boolean;
    FNoDecode: Boolean;
    FOnInitializeISO: TIdInitializeISOEvent;
    FOrganization: string;
    FPriority: TIdMessagePriority;
    FSubject: string;
    FReceiptRecipient: TIdEmailAddressItem;
    FRecipients: TIdEmailAddressList;
    FReferences: string;
    FReplyTo: TIdEmailAddressList;
    FSender: TIdEMailAddressItem;
    FUID: String;
    FXProgram: string;
    //
    procedure DoInitializeISO(var VTransferHeader: TTransfer; var VHeaderEncoding: Char; var VCharSet: string); virtual;
    function GetAttachmentEncoding: string;
    procedure SetAttachmentEncoding(const AValue: string);
    procedure SetBccList(const AValue: TIdEmailAddressList);
    procedure SetBody(const AValue: TStrings);
    procedure SetCCList(const AValue: TIdEmailAddressList);
    procedure SetEncoding(const AValue: TIdMessageEncoding);
    procedure SetExtraHeaders(const AValue: TIdHeaderList);
    procedure SetFrom(const AValue: TIdEmailAddressItem);
    procedure SetHeaders(const AValue: TIdHeaderList);
    procedure SetNewsGroups(const AValue: TStrings);
    procedure SetReceiptRecipient(const AValue: TIdEmailAddressItem);
    procedure SetRecipients(const AValue: TIdEmailAddressList);
    procedure SetReplyTo(const AValue: TIdEmailAddressList);
    procedure SetSender(const AValue: TIdEmailAddressItem);
    procedure SetUseNowForDate(const AValue: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure AddHeader(const AValue: string);
    procedure Clear; virtual;
    procedure ClearBody;
    procedure ClearHeader;
    function GenerateHeader: TIdHeaderList;
    function GetUseNowForDate: Boolean;

    // 2001-Oct-29 Don Siders
    procedure LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False);
    procedure LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False);

    procedure ProcessHeaders;

    // 2001-Oct-29 Don Siders
    procedure SaveToFile(const AFileName : string; const AHeadersOnly: Boolean = False);
    procedure SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False);
    //
    property Flags: TIdMessageFlagsSet read FFlags write FFlags;
    property IsEncoded : Boolean read fIsEncoded write fIsEncoded;
    property MsgId: string read FMsgId write FMsgId;
    property Headers: TIdHeaderList read FHeaders write SetHeaders;
    property MessageParts: TIdMessageParts read FMessageParts;
    property MIMEBoundary: TIdMIMEBoundary read FMIMEBoundary write FMIMEBoundary;
    property UID: String read FUID write FUID;
  published
    //TODO: Make a property editor which drops down the registered coder types
    property AttachmentEncoding: string read GetAttachmentEncoding write SetAttachmentEncoding;
    property Body: TStrings read FBody write SetBody;
    property BccList: TIdEmailAddressList read FBccList write SetBccList;
    property CharSet: string read FCharSet write FCharSet;
    property CCList: TIdEmailAddressList read FCcList write SetCcList;
    property ContentType: string read FContentType write FContentType;
    property ContentTransferEncoding: string read FContentTransferEncoding
     write FContentTransferEncoding;
    property ContentDisposition: string read FContentDisposition write FContentDisposition;
    property Date: TDateTime read FDate write FDate;
    property DeleteTempFiles: Boolean read FDeleteTempFiles
     write FDeleteTempFiles;
    property Encoding: TIdMessageEncoding read FEncoding write SetEncoding;
    property ExtraHeaders: TIdHeaderList read FExtraHeaders write SetExtraHeaders;
    property From: TIdEmailAddressItem read FFrom write SetFrom;
    property NewsGroups: TStrings read FNewsGroups write SetNewsGroups;
    property NoEncode: Boolean read FNoEncode write FNoEncode default ID_MSG_NODECODE;
    property NoDecode: Boolean read FNoDecode write FNoDecode default ID_MSG_NODECODE;
    property Organization: string read FOrganization write FOrganization;
    property Priority: TIdMessagePriority read FPriority write FPriority default ID_MSG_PRIORITY;
    property ReceiptRecipient: TIdEmailAddressItem read FReceiptRecipient write SetReceiptRecipient;
    property Recipients: TIdEmailAddressList read FRecipients write SetRecipients;
    property References: string read FReferences write FReferences;
    property ReplyTo: TIdEmailAddressList read FReplyTo write SetReplyTo;
    property Subject: string read FSubject write FSubject;
    property Sender: TIdEmailAddressItem read FSender write SetSender;
    property UseNowForDate: Boolean read GetUseNowForDate write SetUseNowForDate default ID_MSG_USENOWFORDATE;
    // Events
    property OnInitializeISO: TIdInitializeIsoEvent read FOnInitializeISO write FOnInitializeISO;