flatmime.pas

siMail, siMail, siMail, siMail

(*
# (C) Copyright 2003
# Miha Vrhovnik, [e-mail]
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit flatMime;

interface

uses
  Classes, SysUtils , mimepart;

//this class makes e-mail message flat.
type TFlatMsg = class
  private
    FMsgList: TList;
    FAttachmentList: TList;
    procedure MessageBreakApart(mime: TMimePart; attachment: Boolean);
    function getAttachmentPartCount: Integer;
    function getMsgPartCount: Integer;
    function getAttachment(Index: Integer): TMimePart;
    function getPart(Index: Integer): TMimePart;
  public
    constructor Create;
    destructor  Destroy; override;
    procedure MakeFlat(mime: TMimePart);
    property Parts[Index: Integer]:TMimePart read getPart;
    property Attachments[Index: Integer]:TMimePart read getAttachment;
    //property
  published
    property MsgPartCount: Integer read getMsgPartCount;
    property AttachmentPartCount: Integer read getAttachmentPartCount;
end;

implementation

constructor TFlatMsg.Create;
begin
  inherited Create;

  FMsgList := TList.Create;
  FAttachmentList := TList.Create;
end;

destructor TFlatMsg.Destroy;
begin
  FreeAndNil(FMsgList);
  FreeAndNil(FAttachmentList);

  inherited Destroy;
end;

function TFlatMsg.getAttachment(Index: Integer): TMimePart;
begin
  Result := FAttachmentList.List[Index];
end;

function TFlatMsg.getAttachmentPartCount: Integer;
begin
  Result := FAttachmentList.Count;
end;

function TFlatMsg.getMsgPartCount: Integer;
begin
  Result := FMsgList.Count;
end;

function TFlatMsg.getPart(Index: Integer): TMimePart;
begin
  Result := FMsgList.List[Index];
end;

procedure TFlatMsg.MakeFlat(mime: TMimePart);
begin
  MessageBreakApart(mime, False);
end;

procedure TFlatMsg.MessageBreakApart(mime: TMimePart; attachment: Boolean);
var i: Integer;
begin
  if ((mime.GetSubPartCount = 0) and (mime.FileName = '')) then
    FMsgList.Add(mime)
  //only attachment ?
  else if (mime.GetSubPartCount = 0) then
    FAttachmentList.Add(mime)
  else begin
    for i := 0 to mime.GetSubPartCount - 1 do begin
      if (mime.GetSubPart(i).GetSubPartCount = 0) and
         (mime.GetSubPart(i).FileName = '') then begin //probably text message
        FMsgList.Add(mime.GetSubPart(i));
      end
      else if mime.GetSubPart(i).FileName <> '' then begin //attachment
        if not attachment then begin
          attachment := True;
        end;
        //add attachment to list
        FAttachmentList.Add(mime.GetSubPart(i))
      end
      else if mime.GetSubPart(i).GetSubPartCount > 0 then begin
        MessageBreakApart(mime.GetSubPart(i), attachment);
      end;
    end;
  end;
end;

end.