{ $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:  11667: IdMessage.pas
{
{   Rev 1.26    21/10/2003 23:04:32  CCostelloe
{ Bug fix: removed AttachmentEncoding := '' in SetEncoding.
}
{
{   Rev 1.25    21/10/2003 00:33:04  CCostelloe
{ meMIME changed to meDefault in TIdMessage.Create
}
{
{   Rev 1.24    10/17/2003 7:42:54 PM  BGooijen
{ Changed default Encoding to MIME
}
{
    Rev 1.23    10/17/2003 12:14:08 AM  DSiders
  Added localization comments.
}
{
{   Rev 1.22    2003.10.14 9:57:04 PM  czhower
{ Compile todos
}
{
{   Rev 1.21    10/12/2003 1:55:46 PM  BGooijen
{ Removed IdStrings from uses
}
{
{   Rev 1.20    2003.10.11 10:01:26 PM  czhower
{ .inc path
}
{
{   Rev 1.19    10/10/2003 10:42:26 PM  BGooijen
{ DotNet
}
{
{   Rev 1.18    9/10/2003 1:50:54 PM  SGrobety
{ DotNet
}
{
{   Rev 1.17    10/8/2003 9:53:12 PM  GGrieve
{ use IdCharsets
}
{
{   Rev 1.16    05/10/2003 16:38:50  CCostelloe
{ Restructured MIME boundary output
}
{
{   Rev 1.15    2003.10.02 9:27:50 PM  czhower
{ DotNet Excludes
}
{
{   Rev 1.14    01/10/2003 17:58:52  HHariri
{ More fixes for Multipart Messages and also fixes for incorrect transfer
{ encoding settings
}
{
{   Rev 1.12    9/28/03 1:36:04 PM  RLebeau
{ Updated GenerateHeader() to support the BBCList property
}
{
{   Rev 1.11    26/09/2003 00:29:34  CCostelloe
{ IdMessage.Encoding now set when email decoded; XXencoded emails now decoded;
{ logic added to GenerateHeader
}
{
{   Rev 1.10    04/09/2003 20:42:04  CCostelloe
{ GenerateHeader sets From's Name field to Address field if Name blank;
{ trailing spaces removed after boundary in FindBoundary; force generation of
{ InReplyTo header.
}
{
{   Rev 1.9    29/07/2003 01:14:30  CCostelloe
{ In-Reply-To fixed in GenerateHeader
}
{
{   Rev 1.8    11/07/2003 01:11:02  CCostelloe
{ GenerateHeader changed from function to procedure, results now put in
{ LastGeneratedHeaders.  Better for user (can see headers sent) and code still
{ efficient.
}
{
{   Rev 1.7    10/07/2003 22:39:00  CCostelloe
{ Added LastGeneratedHeaders field and modified GenerateHeaders so that a copy
{ of the last set of headers generated for this message is maintained (see
{ comments starting "CC")
}
{
{   Rev 1.6    2003.06.23 9:46:54 AM  czhower
{ Russian, Ukranian support for headers.
}
{
{   Rev 1.5    6/3/2003 10:46:54 PM  JPMugaas
{ In-Reply-To header now supported.
}
{
    Rev 1.4    1/27/2003 10:07:46 PM  DSiders
  Corrected error setting file stream permissions in LoadFromFile.  Bug Report
  649502.
}
{
{   Rev 1.3    27/1/2003 3:07:10 PM  SGrobety
{ X-Priority header only added if priority <> mpNormal (because of spam filters)
}
{
{   Rev 1.2    09/12/2002 18:19:00  ANeillans    Version: 1.2
{ Removed X-Library Line that was causing people problems with spam detection
{ software , etc.
}
{
{   Rev 1.1    12/5/2002 02:53:56 PM  JPMugaas
{ Updated for new API definitions.
}
{
{   Rev 1.0    11/13/2002 07:56:52 AM  JPMugaas
}
{//////////////////////////////////////////////////////////////////
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;

{
2003-10-04 Ciaran Costelloe (see comments starting CC4)

2003-09-20 Ciaran Costelloe (see comments starting CC2)
  - Added meDefault, meXX to TIdMessageEncoding.
    Code now sets TIdMessage.Encoding when it decodes an email.
    Modified TIdMIMEBoundary to work as a straight stack, now Push/Pops ParentPart also.
    Added meDefault, meXX to TIdMessageEncoding.
    Moved logic from SendBody to GenerateHeader, added extra logic to avoid exceptions:
      Change any encodings we dont know to base64
      We dont support attachments in an encoded body, change it to a supported combination
    Made changes to support ConvertPreamble and MIME message bodies with a
      ContentTransferEncoding of base64, quoted-printable.
    ProcessHeaders now decodes BCC list.
2003-09-02 Ciaran Costelloe
  - Added fix to FindBoundary suggested by Juergen Haible to remove trailing space
    after boundary added by some clients.
2003-07-10 Ciaran Costelloe
  - Added LastGeneratedHeaders property, see comments starting CC.  Changed
    GenerateHeader from function to procedure, it now puts the generated headers
    into LastGeneratedHeaders, which is where dependant units should take the
    results from.  This ensures that the headers that were generated are
    recorded, which some users' programs may need.
2002-12-09 Andrew Neillans
  - Removed X-Library line
2002-08-30 Andrew P.Rybin
  - now InitializeISO is IdMessage method
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.
}

                                                                                        

                                             

{ 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

{$I Core\IdCompilerDefines.inc}

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

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

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

type
  TIdMIMEBoundary = class
  protected
    FBoundaryList: TStrings;
    //FNewBoundary: Boolean;  //CC: No longer used
    {CC: Added ParentPart as a TStrings so I dont have to create a TIntegers}
    FParentPartList: TStrings;
    function GetBoundary: string;
    function GetParentPart: integer;
  public
    constructor Create;
    destructor Destroy; override;
    class function FindBoundary(AContentType: string): string;
    //procedure Push(ABoundary: string);
    procedure Push(ABoundary: string; AParentPart: integer);
    procedure Pop;
    procedure Clear;
    function Count: integer;

    property Boundary: string read GetBoundary;
    property ParentPart: integer read GetParentPart;
    //property NewBoundary: Boolean read FNewBoundary write FNewBoundary;  //CC: No longer used
  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;

  {CC2: Added meDefault, meXX.  When decoding a message, these are set to the message
  encoding found.  When encoding, the user lets Indy decide on the encoding by
  leaving it at meDefault, or he can pick MIME, UUE or XXE encoding.}
  TIdMessageEncoding = (meDefault, meMIME, meUU, meXX);

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

  TIdMessage = class;

  TIdCreateAttachmentEvent = procedure(const AMsg:TIdMessage; const AHeaders: TStrings;
    var AAttachment: TIdAttachment) of object;

  TIdMessage = class(TIdBaseComponent)
  protected
    FBccList: TIdEmailAddressList;
    FBody: TStrings;
    FCharSet: string;
    FCcList: TIdEmailAddressList;
    FContentType: string;
    FContentTransferEncoding: string;
    FContentDisposition: string;
    FDate: TDateTime;
    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;
    FInReplyTo : String;
    FReplyTo: TIdEmailAddressList;
    FSender: TIdEMailAddressItem;
    FUID: String;
    FXProgram: string;
    FCreateAttachmentClass: TIdAttachmentClass;
    FOnCreateAttachment: TIdCreateAttachmentEvent;
    FLastGeneratedHeaders: TIdHeaderList;
    FConvertPreamble: Boolean;
    //
    function FixUpMsgID(const AValue : String) : String;
    procedure DoInitializeISO(var VTransferHeader: TTransfer; var VHeaderEncoding: Char; var VCharSet: String); virtual;
    function  GetAttachmentEncoding: string;
    procedure SetAttachmentEncoding(const AValue: string);
    procedure SetEncoding(const AValue: TIdMessageEncoding);
    procedure SetInReplyTo(const AValue : String);
    function GetInReplyTo : String;
    procedure SetMsgID(const AValue : String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure AddHeader(const Value: string);
    procedure Clear; virtual;
    procedure ClearBody;
    procedure ClearHeader;
    procedure GenerateHeader;
    function  GetUseNowForDate: Boolean;
    procedure InitializeISO(var VTransferHeader: TTransfer;
     var VHeaderEncoding: Char; var VCharSet: String);
    function  IsBodyEncodingRequired: Boolean;

    // 2001-Oct-29 Don Siders
    {$IFNDEF DotNetExclude}
    procedure LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False);
    procedure LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False);
    {$ENDIF}

    procedure ProcessHeaders;

    // 2001-Oct-29 Don Siders
    {$IFNDEF DotNetExclude}
    procedure SaveToFile(const AFileName : string; const AHeadersOnly: Boolean = False);
    procedure SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False);
    {$ENDIF}

    procedure SetBody(const Value: TStrings);
    procedure SetNewsGroups(const Value: TStrings);
    procedure SetExtraHeaders(const Value: TIdHeaderList);
    procedure SetUseNowForDate(const Value: Boolean);
    procedure DoCreateAttachment(const AHeaders: TStrings;
      var AAttachment: TIdAttachment); virtual;
    //
    property Flags: TIdMessageFlagsSet read FFlags write FFlags;
    property IsEncoded : Boolean read fIsEncoded write fIsEncoded;
    property MsgId: string read FMsgId write SetMsgID;
    property Headers: TIdHeaderList read FHeaders;
    property MessageParts: TIdMessageParts read FMessageParts;
    property MIMEBoundary: TIdMIMEBoundary read FMIMEBoundary write FMIMEBoundary;
    property UID: String read FUID write FUID;

    // something to implement in memory decoding of attachments:
    property CreateAttachmentClass: TIdAttachmentClass
      read FCreateAttachmentClass
      write FCreateAttachmentClass;
  published
                                                                              
    property AttachmentEncoding: string read GetAttachmentEncoding write SetAttachmentEncoding;
    property Body: TStrings read FBody write SetBody;
    property BccList: TIdEmailAddressList read FBccList write FBccList;
    property CharSet: string read FCharSet write FCharSet;
    property CCList: TIdEmailAddressList read FCcList write FCcList;
    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 Encoding: TIdMessageEncoding read FEncoding write SetEncoding;
    property ExtraHeaders: TIdHeaderList read FExtraHeaders write SetExtraHeaders;
    property From: TIdEmailAddressItem read FFrom write FFrom;
    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 FReceiptRecipient;
    property Recipients: TIdEmailAddressList read FRecipients write FRecipients;
    property References: string read FReferences write FReferences;
    property InReplyTo : String read GetInReplyTo write SetInReplyTo;
    property ReplyTo: TIdEmailAddressList read FReplyTo write FReplyTo;
    property Subject: string read FSubject write FSubject;
    property Sender: TIdEmailAddressItem read FSender write FSender;
    property UseNowForDate: Boolean read GetUseNowForDate write SetUseNowForDate default ID_MSG_USENOWFORDATE;
    property LastGeneratedHeaders: TIdHeaderList read FLastGeneratedHeaders;
    property ConvertPreamble: Boolean read FConvertPreamble write FConvertPreamble;
    // Events
    property OnInitializeISO: TIdInitializeIsoEvent read FOnInitializeISO write FOnInitializeISO;
    property OnCreateAttachment: TIdCreateAttachmentEvent read FOnCreateAttachment write FOnCreateAttachment;
  End;

  TIdMessageEvent = procedure(ASender : TComponent; var AMsg : TIdMessage) of object;

  TIdStringMessageEvent = procedure(ASender : TComponent; const AString : String; var AMsg : TIdMessage) of object;

  EIdTextInvalidCount = class(EIdMessageException);

  // 2001-Oct-29 Don Siders
  EIdMessageCannotLoad = class(EIdMessageException);

const
  MessageFlags : array [mfAnswered..mfRecent] of String =
  ( '\Answered', {Do not Localize} //Message has been answered.
    '\Flagged', {Do not Localize} //Message is "flagged" for urgent/special attention.
    '\Deleted', {Do not Localize} //Message is "deleted" for removal by later EXPUNGE.
    '\Draft', {Do not Localize} //Message has not completed composition (marked as a draft).
    '\Seen', {Do not Localize} //Message has been read.
    '\Recent' ); {Do not Localize} //Message is "recently" arrived in this mailbox.

  INREPLYTO = 'In-Reply-To'; {Do not localize}

implementation

uses
  {$IFNDEF DotNetExclude}
  IdIOHandlerStream,
  {$ENDIF}
  IdMessageCoderMIME, // Here so the 'MIME' in create will always suceed
  IdCharSets, IdCoreGlobal, IdGlobal, IdMessageCoder, IdResourceStrings, //IdStream,
  IdMessageClient, IdAttachmentFile,
  IdText;

{ TIdMIMEBoundary }

procedure TIdMIMEBoundary.Clear;
begin
  FBoundaryList.Clear;
  FParentPartList.Clear;
end;

function TIdMIMEBoundary.Count: integer;
begin
  Result := FBoundaryList.Count;
end;

constructor TIdMIMEBoundary.Create;
begin
  inherited Create;
  FBoundaryList := TStringList.Create;
  FParentPartList := TStringList.Create;
end;

destructor TIdMIMEBoundary.Destroy;
begin
  FBoundaryList.Free;
  FParentPartList.Free;
  inherited Destroy;
end;

class function TIdMIMEBoundary.FindBoundary(AContentType: string): string;
var
  s: string;
begin
  // Store in s and not Result because of Fetch semantics
  s := UpperCase(AContentType);
  Fetch(s, 'BOUNDARY='); {do not localize}
  {CC: Fix suggested by Juergen Haible - some clients add a space after the boundary,
  remove it by calling Trim(s)...}
  s := Trim(s);
  if (Length(s) > 0) and (s[1] = '"') then begin {do not localize}
    Delete(s, 1, 1);
    Result := Fetch(s, '"'); {do not localize}
  // Should never occur, and if so bigger problems but just in case we'll try
  end else begin
    Result := s;
  end;
end;

function TIdMIMEBoundary.GetBoundary: string;
begin
  if FBoundaryList.Count > 0 then begin
    Result := FBoundaryList.Strings[0];
  end else begin
    Result := '';
  end;
end;

function TIdMIMEBoundary.GetParentPart: integer;
begin
  if FParentPartList.Count > 0 then begin
    Result := StrToInt(FParentPartList.Strings[0]);
  end else begin
    Result := -1;
  end;
end;

procedure TIdMIMEBoundary.Pop;
begin
  FBoundaryList.Delete(0);
  FParentPartList.Delete(0);
end;

procedure TIdMIMEBoundary.Push(ABoundary: string; AParentPart: integer);
begin
  {CC: Changed implementation to a simple stack}
  FBoundaryList.Insert(0, ABoundary);
  FParentPartList.Insert(0, IntToStr(AParentPart));
  {
  if (FBoundaryList.Count > 0) and (AnsiSameText(ABoundary, FBoundaryList.Strings[0])) then begin
    FNewBoundary := True;
  end else begin
    if Length(ABoundary) > 0 then begin
      FBoundaryList.Insert(0, ABoundary);
      FParentPartList.Insert(0, IntToStr(AParentPart));
      FNewBoundary := False;
    end;
  end;
  }
end;


{ TIdMessage }

procedure TIdMessage.AddHeader(const Value: string);
begin
  FHeaders.Add(Value);
end;

procedure TIdMessage.Clear;
begin
  ClearHeader;
  ClearBody;
end;

procedure TIdMessage.ClearBody;
begin
  MessageParts.Clear ;
  Body.Clear;
end;

procedure TIdMessage.ClearHeader;
begin
  CcList.Clear;
  BccList.Clear;
  Date := 0;
  From.Text := '';
  NewsGroups.Clear;
  Organization := '';
  References := '';
  ReplyTo.Clear;
  Subject := '';
  Recipients.Clear;
  Priority := ID_MSG_PRIORITY;
  ReceiptRecipient.Text := '';
  ContentType := '';
  FCharSet := '';
  ContentTransferEncoding := '';
  ContentDisposition := '';
  FSender.Text := '';
  Headers.Clear;
  ExtraHeaders.Clear;
  FMIMEBoundary.Clear;
  UseNowForDate := ID_MSG_USENOWFORDATE;
  Flags := [];
  FLastGeneratedHeaders.Clear;
  FEncoding := meDefault; {CC3: Changed initial encoding from meMIME to meDefault}
  FConvertPreamble := True;  {By default, in MIME, we convert the preamble text to the 1st TIdText part}
end;

constructor TIdMessage.Create(AOwner: TComponent);
begin
  inherited;
  FBody := TStringList.Create;
  FRecipients := TIdEmailAddressList.Create(Self);
  FBccList := TIdEmailAddressList.Create(Self);
  FCcList := TIdEmailAddressList.Create(Self);
  FMessageParts := TIdMessageParts.Create(Self);
  FNewsGroups := TStringList.Create;
  FHeaders := TIdHeaderList.Create;
  FFrom := TIdEmailAddressItem.Create(nil);
  FReplyTo := TIdEmailAddressList.Create(Self);
  FSender := TIdEmailAddressItem.Create(nil);
  FExtraHeaders := TIdHeaderList.Create;
  FReceiptRecipient := TIdEmailAddressItem.Create(nil);
  NoDecode := ID_MSG_NODECODE;
  FMIMEBoundary := TIdMIMEBoundary.Create;
  FLastGeneratedHeaders := TIdHeaderList.Create;
  Clear;
  FCreateAttachmentClass := TIdAttachmentFile;
  FEncoding := meDefault;
end;

destructor TIdMessage.Destroy;
begin
  FBody.Free;
  FRecipients.Free;
  FBccList.Free;
  FCcList.Free;
  FMessageParts.Free;
  FNewsGroups.Free;
  FHeaders.Free;
  FExtraHeaders.Free;
  FFrom.Free;
  FReplyTo.Free;
  FSender.Free;
  FReceiptRecipient.Free;
  FMIMEBoundary.Free;
  FLastGeneratedHeaders.Free;
  inherited destroy;
end;


procedure TIdMessage.SetBody(const Value: TStrings);
begin
  FBody.Assign(Value);
end;

procedure TIdMessage.SetNewsGroups(const Value: TStrings);
begin
  FNewsgroups.Assign(Value);
end;

procedure TIdMessage.GenerateHeader;
var
  ISOCharset: string;
  HeaderEncoding: Char;
  TransferHeader: TTransfer;
  LN: Integer;
  LEncoding: string;
  LMIMEBoundary: string;
begin
                   
  MessageParts.CountParts;
  {CC2: If the encoding is meDefault, the user wants us to pick an encoding mechanism:}
  if Encoding = meDefault then begin
    if MessageParts.Count = 0 then begin
      {If there are no attachments, we want the simplest type, just the headers
      followed by the message body: UU does this for us (note there are no
      attachments, picking meUU will not generate any UU-encoded message content)}
      Encoding := meUU;
    end else begin
      {If there are any attachments, default to MIME...}
      Encoding := meMIME;
    end;
  end;
  for LN := 0 to MessageParts.Count-1 do begin
    {CC2: Change any encodings we dont know to base64...}
    LEncoding := MessageParts[LN].ContentTransfer;
    if ((LEncoding <> '') and (AnsiSameText(LEncoding, '7bit') = False) and {do not localize}
      (AnsiSameText(LEncoding, '8bit') = False) and                         {do not localize}
      (AnsiSameText(LEncoding, 'binary') = False) and                       {do not localize}
      (AnsiSameText(LEncoding, 'base64') = False) and                       {do not localize}
      (AnsiSameText(LEncoding, 'quoted-printable') = False)) then begin     {do not localize}
      MessageParts[LN].ContentTransfer := 'base64';                         {do not localize}
    end;
  end;
  {CC2: We dont support attachments in an encoded body.
  Change it to a supported combination...}
  if MessageParts.Count > 0 then begin
    if ((ContentTransferEncoding <> '') and
        (AnsiSameText(ContentTransferEncoding, '7bit') = False) and         {do not localize}
        (AnsiSameText(ContentTransferEncoding, 'binary') = False) and       {do not localize}
        (AnsiSameText(ContentTransferEncoding, '8bit') = False)) then begin {do not localize}
      ContentTransferEncoding := '';
    end;
  end;
  if Encoding = meMIME then begin
    //HH: Generate Boundary here so we know it in the headers
    LMIMEBoundary := IdMIMEBoundaryStrings.IndyMIMEBoundary;
    //CC: Moved this logic up from SendBody to here, where it fits better...
    if Length(ContentType) = 0 then begin
      //User has omitted ContentType.
      //See if it is multipart/alternative...
//      if ( (MessageParts.TextPartCount > 1)
//       and (((AnsiSameText(MessageParts.Items[0].ContentType, 'text/plain')) and (AnsiSameText(MessageParts.Items[1].ContentType, 'text/html')))
//        or ((AnsiSameText(MessageParts.Items[1].ContentType, 'text/plain')) and (AnsiSameText(MessageParts.Items[0].ContentType, 'text/html'))))
//       ) then begin
      if MessageParts.TextPartCount > 1 then begin
        if MessageParts.AttachmentCount > 1 then begin
          ContentType := 'multipart/mixed';  //; boundary="' + LMIMEBoundary + '"';  {do not localize}
        end else begin
          ContentType := 'multipart/alternative'; //; boundary="' + LMIMEBoundary + '"';  {do not localize}
        end;
      end;
    end;
    TIdMessageEncoderInfo(MessageParts.MessageEncoderInfo).InitializeHeaders(Self);
    if FCharSet > '' then begin
      if Length(ContentType) = 0 then begin
        ContentType := 'charset="' + FCharSet + '"';  {do not localize}
      end else begin
        ContentType := ContentType + ';' + EOL + TAB + 'charset="' + FCharSet + '"';  {do not localize}
      end;
    end;
  end else begin
    // Check message parts
    {CC: The user may be trying to save an iffy email he received, we should not
         be generating an exception if we dont like it, so I commented this out.
    with MessageParts do begin
      //if (RelatedPartCount > 0) or (TextPartCount > 0) then begin
      if RelatedPartCount > 0 then begin
        raise EIdMessageException.Create(RSMsgClientInvalidEncoding);
      end;
    end;
    }
  end;

  InitializeISO(TransferHeader, HeaderEncoding, ISOCharSet);
  LastGeneratedHeaders.Clear;


  if (FHeaders.Count > 0) then begin
    LastGeneratedHeaders.Assign(FHeaders);
  end;

  with LastGeneratedHeaders do
  begin
    {CC: If From has no Name field, use the Address field as the Name field by setting last param to True (for SA)...}
    Values['From'] := EncodeAddressItem(From, HeaderEncoding, TransferHeader, ISOCharSet, True); {do not localize}
    Values['Subject'] := EncodeHeader(Subject, [], HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    Values['To'] := EncodeAddress(Recipients, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    Values['Cc'] := EncodeAddress(CCList, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    {RL: Added support for BCCList...}
    Values['Bcc'] := EncodeAddress(BCCList, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    Values['Newsgroups'] := NewsGroups.CommaText; {do not localize}
    {CC: Force generation of In-Reply-To to pacify SA...}
    if InReplyTo = '' then begin
      Values['In-Reply-To'] := Subject;   {do not localize}
    end else begin
      Values['In-Reply-To'] := InReplyTo; {do not localize}
    end;
    if Encoding = meMIME then
    begin
      {CC4: Add the boundary at this point...}
      //Values['Content-Type'] := ContentType; {do not localize}
      Values['Content-Type'] := ContentType + '; boundary="' + LMIMEBoundary + '"'; {do not localize}

      {CC2: We may have MIME with no parts if ConvertPreamble is True}
      //if MessageParts.Count > 0 then begin
        Values['MIME-Version'] := '1.0'; {do not localize}
      //end;
      Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
    end else begin
      //CC: non-MIME can have ContentTransferEncoding of base64, quoted-printable...
      Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
      Values['Content-Type'] := ContentType;  {do not localize}
    end;
    Values['Sender'] := Sender.Text; {do not localize}
    Values['Reply-To'] := EncodeAddress(ReplyTo, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    Values['Organization'] := EncodeHeader(Organization, [], HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}

    Values['Disposition-Notification-To'] := EncodeAddressItem(ReceiptRecipient, {do not localize}
      HeaderEncoding, TransferHeader, ISOCharSet);

    Values['References'] := References; {do not localize}

    if UseNowForDate then
    begin
      Values['Date'] := DateTimeToInternetStr(Now); {do not localize}
    end
    else begin
      Values['Date'] := DateTimeToInternetStr(Self.Date); {do not localize}
		end;

    // S.G. 27/1/2003: Only issue X-Priority header if priority <> mpNormal (for stoopid spam filters)
    if Priority <> mpNormal then
      Values['X-Priority'] := IntToStr(Ord(Priority) + 1) {do not localize}
    else
    begin
      if IndexOfName('X-Priority') >= 0 then  {do not localize}
        delete(IndexOfName('X-Priority'));    {do not localize}
    end;

    // Add extra headers created by UA - allows duplicates
    if (FExtraHeaders.Count > 0) then
    begin
      AddStrings(FExtraHeaders);
    end;
  end;
end;

procedure TIdMessage.ProcessHeaders;
var
  ABoundary: string;

  // Some mailers send priority as text, number or combination of both
  function GetMsgPriority(Priority:string): TIdMessagePriority;
  var
    s: string;
    Num: integer;
  begin
    // This is for Pegasus.
    if IndyPos('urgent', LowerCase(Priority)) <> 0 then begin {do not localize}
      Result := mpHigh;
    end else if IndyPos('non-priority', LowerCase(Priority)) <> 0 then begin {do not localize}
			Result := mpLow;
    end else begin
      s := Trim(Priority);
      s := Trim(Fetch(s, ' '));
      Num := StrToIntDef(s, 3);
      Result := TIdMessagePriority(Num - 1);
    end;
  end;

  procedure ExtractCharSet;
  var
    s: string;
  begin
    s := UpperCase(ContentType);
    Fetch(s, 'CHARSET='); {do not localize}
    if Copy(s, 1, 1) = '"' then begin {do not localize}
      Delete(s, 1, 1);
      FCharset := Fetch(s, '"'); {do not localize}
    // Sometimes its not in quotes
    end else begin
      FCharset := Fetch(s, ';');
    end;
  end;

begin
  ContentType := Headers.Values['Content-Type']; {do not localize}
  ExtractCharSet;

  ContentTransferEncoding := Headers.Values['Content-Transfer-Encoding']; {do not localize}
  ContentDisposition := Headers.Values['Content-Disposition'];  {do not localize}
  Subject := DecodeHeader(Headers.Values['Subject']); {do not localize}
  From.Text := DecodeHeader(Headers.Values['From']); {do not localize}
  MsgId := Headers.Values['Message-Id']; {do not localize}
  CommaSeparatedToStringList(Newsgroups, Headers.Values['Newsgroups']); {do not localize}
  Recipients.EMailAddresses := DecodeHeader(Headers.Values['To']); {do not localize}
  CCList.EMailAddresses := DecodeHeader(Headers.Values['Cc']); {do not localize}
  {CC2: Added support for BCCList...}
  BCCList.EMailAddresses := DecodeHeader(Headers.Values['Bcc']); {do not localize}
  Organization := Headers.Values['Organization']; {do not localize}
  ReceiptRecipient.Text := Headers.Values['Disposition-Notification-To']; {do not localize}

  if Length(ReceiptRecipient.Text) = 0 then begin
    ReceiptRecipient.Text := Headers.Values['Return-Receipt-To']; {do not localize}
  end;

  References := Headers.Values['References']; {do not localize}
  ReplyTo.EmailAddresses := Headers.Values['Reply-To']; {do not localize}
  Date := GMTToLocalDateTime(Headers.Values['Date']); {do not localize}
  Sender.Text := Headers.Values['Sender']; {do not localize}

  if Length(Headers.Values['Priority']) = 0 then begin {do not localize}
    Priority := GetMsgPriority(Headers.Values['X-Priority']) {do not localize}
  end else begin
    Priority := GetMsgPriority(Headers.Values['Priority']); {do not localize}
  end;
  ABoundary := MIMEBoundary.FindBoundary(ContentType);
  MIMEBoundary.Push(ABoundary, -1);
  {CC2: Set encoding (meXX cannot be distinguished from meUU
  this stage, we are setting it to meUU for now)...}
  if ABoundary = '' then begin
    Encoding := meUU;
  end else begin
    Encoding := meMIME;
  end;
end;

procedure TIdMessage.SetExtraHeaders(const Value: TIdHeaderList);
begin
  FExtraHeaders.Assign(Value);
end;

function TIdMessage.GetUseNowForDate: Boolean;
begin
  Result := (FDate = 0);
end;

procedure TIdMessage.SetUseNowForDate(const Value: Boolean);
begin
    Date := 0;
end;

procedure TIdMessage.SetAttachmentEncoding(const AValue: string);
begin
  MessageParts.AttachmentEncoding := AValue;
end;

function TIdMessage.GetAttachmentEncoding: string;
begin
  Result := MessageParts.AttachmentEncoding;
end;

procedure TIdMessage.SetEncoding(const AValue: TIdMessageEncoding);
begin
  {CC2: Added support for meXX...}
  FEncoding := AValue;
  if AValue = meUU then begin
    AttachmentEncoding := 'UUE';    {do not localize}
  end else if AValue = meXX then begin
    AttachmentEncoding := 'XXE';    {do not localize}
  end else begin
    AttachmentEncoding := 'MIME';    {do not localize}
  end;
end;

{$IFNDEF DotNetExclude}
procedure TIdMessage.LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False);
var
  vStream: TFileStream;
begin
  if (not FileExists(AFilename)) then
  begin
    raise EIdMessageCannotLoad.CreateFmt(RSIdMessageCannotLoad, [AFilename]);
  end;

  vStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(vStream, AHeadersOnly);
  finally
    vStream.Free;
  end;
end;
{$ENDIF}

{$IFNDEF DotNetExclude}
procedure TIdMessage.LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False);
var
  vMsgClient : TIdMessageClient;
begin
  // clear message properties, headers before loading
  Clear;
  vMsgClient := TIdMessageClient.Create(nil);
  try
    vMsgClient.ProcessMessage(Self, AStream, AHeadersOnly);
  finally
    FreeAndNil(vMsgClient);
  end;
end;
{$ENDIF}

{$IFNDEF DotNetExclude}
procedure TIdMessage.SaveToFile(const AFileName: string; const AHeadersOnly: Boolean = False);
var
  vStream : TFileStream;
begin
  if FileExists(AFileName) then
  begin
    DeleteFile(AFileName);
  end;

  vStream := TFileStream.create(AFileName, fmCreate);
  try
    SaveToStream(vStream, AHeadersOnly);
  finally
    vStream.Free;
  end;
end;
{$ENDIF}

{$IFNDEF DotNetExclude}
                                                                                                                             
procedure TIdMessage.SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False);
var
  vMsgClient: TIdMessageClient;
  vIOHandler: TIdIOHandlerStream;
  vVoidStream: TMemoryStream;
begin
  vVoidStream := TMemoryStream.Create;
  vIOHandler := TIdIOHandlerStream.Create(nil);
  vMsgClient := TIdMessageClient.Create(nil);

todo;
  vIOHandler.StreamType := stWrite;
//  vIOHandler.TargetWriteStream := AStream;
//  vIOHandler.SourceReadStream := vVoidStream;
  vMsgClient.IOHandler := vIOHandler;

  try
//    vMsgClient. . OpenWriteBuffer(32768);
    vMsgClient.SendMsg(Self, AHeadersOnly);
    // add the end of message marker when body is included
    if (not AHeadersOnly) then vMsgClient.IOHandler.WriteLn('.');
//    vMsgClient.CloseWriteBuffer;
  finally
todo;
//    vIOHandler.TargetWriteStream := nil;
//    vIOHandler.SourceReadStream := nil;
    vVoidStream.Free;

    FreeAndNil(vIOHandler);
    FreeAndNil(vMsgClient);
  end;
end;
{$ENDIF}

procedure TIdMessage.DoInitializeISO(var VTransferHeader: TTransfer;
  var VHeaderEncoding: Char; var VCharSet: string);
Begin
  if Assigned(FOnInitializeISO) then FOnInitializeISO(VTransferHeader, VHeaderEncoding, VCharSet);//APR
End;//

procedure TIdMessage.InitializeISO(var VTransferHeader: TTransfer; var VHeaderEncoding: Char; var VCharSet: String);
Begin
  VTransferHeader := bit8;    { header part conversion type }
  VHeaderEncoding := 'B';     { base64 / quoted-printable }    {Do not Localize}
  VCharSet := IdCharsetNames[IdGetDefaultCharSet];

  // it's not clear when VHeaderEncoding should be Q not B.
  // Comments welcome on atozedsoftware.indy.general

  case IdGetDefaultCharSet of
    idcsISO_2022_JP : VTransferHeader := iso2022jp; { header needs conversion }
    idcsISO_8859_1 : VHeaderEncoding := 'Q';    {Do not Localize}
    idcsUNICODE_1_1 : VCharSet := IdCharsetNames[idcsUTF_8];
  else
    // nothing
  end;
  DoInitializeISO(VTransferHeader, VHeaderEncoding, VCharSet);
End;

procedure TIdMessage.DoCreateAttachment(const AHeaders: TStrings;
  var AAttachment: TIdAttachment);
begin
  AAttachment := nil;
  if Assigned(FOnCreateAttachment) then begin
    FOnCreateAttachment(Self, AHeaders, AAttachment);
  end;
  if not Assigned(AAttachment) then begin
    AAttachment := CreateAttachmentClass.Create(Self.MessageParts);
  end;
end;

function TIdMessage.IsBodyEncodingRequired: Boolean;
var
  i,j: Integer;
  S: String;
Begin
  Result := FALSE;//7bit
  for i:=0 to FBody.Count-1 do begin
    S := FBody[i];
    for j := 1 to Length(S) do begin
      if S[j] > #127 then begin
        Result := TRUE;
        EXIT;
      end;
    end;
  end;
End;//

function TIdMessage.GetInReplyTo: String;
begin
  Result := FixUpMsgID(FInReplyTo);
end;

procedure TIdMessage.SetInReplyTo(const AValue: String);
begin
  FInReplyTo := FixUpMsgID(AValue);
end;

function TIdMessage.FixUpMsgID(const AValue: String): String;
begin
  Result := AValue;
  if (Result<>'') then
  begin
    if (Result[1]<>'<') then
    begin
      {$ifdef DotNet}Borland.Delphi.{$endif}System.Insert('<',Result,1);  //BGO: TODO: remove the ifdef
    end;
    if (Result[Length(Result)]<>'>') then
    begin
      Result := Result + '>';
    end;
  end;
end;

procedure TIdMessage.SetMsgID(const AValue: String);
begin
  FMsgId := FixUpMsgID(AValue);
end;

end.

