タイトル：E-mail の multipart 構造を TreeView に表示する。

　multipartが入れ子（multipartの中にmultipart）になったメールを
先日受け取り、そんなメールでも正しくパートを取得できるようにして
みました。
（私は FastNet の NM〜コンポーネントを使わずに TClientSocket を
使用（Socket習得、APOP対応）しているため）

　TMimePart は各パートに対応するクラスです。
FHeader がヘッダ情報を TStringList 型で記録し、
FBody がそのパートの内容を記録します。
    単一パートであれば FBody は TStringList 型、
    multipart の場合には子パートのリストを TObjectList で記録
しています。
ヘッダー（FHeader）の Content-Type（multipartか否か）と FBody
の型（TStringList、TObjectList）の整合性を保つ仕組みはないので
注意してください。
　TMimePartBuilder は受信したメール情報を１行ずつ入力することで
TMimePart の階層構造を作るためのクラスです。

　階層化した TMimePart の編集と、その multipart な送信メールへ
の書き出しも比較的簡単にできる（MIME 関連の知識が少し必要）と
思いますがいかがでしょうか？


// contnrs ユニットを uses 節に追加しておきます。
type
  // 各パートに対応するクラス
  TMimePart = class
  private
    FHeader: TStringList; // ヘッダ情報を入れる
    FBody: TObject; // multipartはTObjectList、他はTStringList
  protected
    function GetBoundary: string; // ヘッダから Boundary を得る
    function GetContentType: string;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear;
    property Body: TObject read FBody;
    property ContentType: string read GetContentType;
  end;

  // 受信データからTMimePartのツリー構造作成を補助するためのクラス
  TMimePartBuilder = class
  private
    FBoundaryList: TStringList; // 書込み中のパートとBoundaryを記録
    FRootPart: TMimePart;
  public
    constructor Create(ARootPart: TMimePart);
    destructor Destroy; override;
    procedure PutText(Text: string); // １行ずつここから書き込む
  end;

implementation

{ TMimePart }

procedure TMimePart.Clear;
begin
  FHeader.Clear;
  if Assigned(FBody) then
  begin
    FBody.Free;
    FBody := nil;
  end;
end;

constructor TMimePart.Create;
begin
  inherited Create;
  FHeader := TStringList.Create;
end;

destructor TMimePart.Destroy;
begin
  FHeader.Free;
  if Assigned(FBody) then FBody.Free;
  inherited Destroy;
end;

function TMimePart.GetBoundary: string;
var
  I, J: Integer;
  S: string;
begin
  Result := '';
  S := GetContentType;
  for I := 1 to Length(S) - 1 do
  begin
    if (StrLIComp(PChar(S) + I, 'Boundary=', 9) = 0)and
       not IsCharAlphaNumeric(S[I]) then
    begin
      Delete(S, 1, I + 9);
      J := Pos(';', S);
      if J > 0 then
        S := Copy(S, 1, J - 1);
      if (Length(S) > 1) and (S[1] = '"') and
         (S[Length(S)] = '"') then
        S := Copy(S, 2, Length(S) - 2);
      Result := S;
      break;
    end;
  end;
end;

function TMimePart.GetContentType: string;
var
  I, J: Integer;
  S: string;
begin
  Result := '';
  for I := 0 to FHeader.Count - 1 do
  begin
    S := FHeader[I];
    if StrLIComp(PChar(S), 'Content-Type:', 13) = 0 then
    begin
      Delete(S, 1, 13);
      Result := trim(S);
      for J := I + 1 to FHeader.Count - 1 do
      begin
        S := FHeader[J];
        if (Length(S) = 0) or IsCharAlphaNumeric(S[1]) then
          break;
        Result := Result + S;
      end;
      break;
    end; // for I := 0 to FHeader.Count - 1 do
  end;
end;

{ TMimePartBuilder }

constructor TMimePartBuilder.Create(ARootPart: TMimePart);
begin
  inherited Create;
  FBoundaryList := TStringList.Create;
  FRootPart := ARootPart;
  FRootPart.Clear; // 内容を一旦クリアする
end;

destructor TMimePartBuilder.Destroy;
begin
  FBoundaryList.Free;
  inherited Destroy;
end;

procedure TMimePartBuilder.PutText(Text: string);
  
  function CheckBoundary: Integer;
  var
    Boundary: string;
  begin
    Result := 0;
    if FBoundaryList.Count = 0 then Exit;
    Boundary := FBoundaryList[FBoundaryList.Count - 1];
    if StrLComp(PChar(Text), PChar(Boundary), Length(Boundary))
      = 0 then
    begin
      if Text = Boundary then
        Result := 1
      else if Text = (Boundary + '--') then
        Result := 2;
    end;
  end;
  
  procedure WritePart(Part: TMimePart);
  begin
    if Part.FBody = nil then // ヘッダに書き込む
    begin
      if Length(Text) > 0 then
        Part.FHeader.Add(Text)
      // Part.GetBoundary で multipart かどうかを判断
      else if Length(Part.GetBoundary) = 0 then
        // multipart ではないので TStringList を Body にする
        Part.FBody := TStringList.Create
      else
      begin
        // multipart なので TObjectList を Body にする
        Part.FBody := TObjectList.Create;
        // 以後は、この Body 内の Part に書き込むように登録
        FBoundaryList.AddObject(
          '--' + Part.GetBoundary, Part.FBody);
      end;
    end
    else if Part.FBody is TStringList then
      // 既存の Body に書き込む
      TStringList(Part.FBody).Add(Text)
    else; // Part.FBody is TObjectList
  end;
  
var
  Body: TList;
begin
  if FBoundaryList.Count = 0 then
    // Part が階層構造になっていない
    WritePart(FRootPart)
  else // FBoundaryList.Count > 0
  begin
    // 書き込み中の Body の Boundary をチェックする
    Body := TList(FBoundaryList.Objects[FBoundaryList.Count - 1]);
    case CheckBoundary of
    0: // Boundary ではない
       if Body.Count > 0 then // Body 内に Part があれば
         WritePart(Body.Last);// 最後尾の Part に書き込む
    1: // 新規 Part の開始を示す Boundary
       Body.Add(TMimePart.Create);
    2: // multipart な Body の終了を示す Boundary
       FBoundaryList.Delete(FBoundaryList.Count - 1); // 登録解除
    end; // case CheckBoundary of
  end;
end;


// 以下は、TMimePart と TMimePartBuilder の使用例です。
// フォームにTreeView、TButton、TOpenDialogを１個ずつ置きます。

procedure TForm1.Button1Click(Sender: TObject);
var
  Part: TMimePart;
  Builder: TMimePartBuilder;
  Strings: TStringList;
  I: Integer;
begin
  if OpenDialog1.Execute then
  begin
    // OutlookExpressの *.eml ファイル等を TStringList に読み込んで
    Strings := TStringList.Create;
    Strings.LoadFromFile(OpenDialog1.FileName);
    Part := TMimePart.Create;
    Builder := TMimePartBuilder.Create(Part);
    
    // １行ずつ TMimePartBuilder に入力します。
    for I := 0 to Strings.Count - 1 do
      Builder.PutText(Strings[I]);
    Builder.Free;
    Strings.Free;
    
    // 完成した Part をツリービューに表示します
    PartToTreeView(Part);
    TreeView1.FullExpand;
    Part.Free;
  end;
end;

procedure TForm1.PartToTreeView(Part: TMimePart);
  
  procedure AddPart(Parent: TTreeNode; Part: TMimePart);
  var
    Node: TTreeNode;
    I: Integer;
  begin
    Node := TreeView1.Items.AddChild(Parent, Part.ContentType);
    
    // 子パート（multipart構造）があったら追加する
    if Part.Body is TList then
    for I := 0 to TList(Part.Body).Count - 1 do
      AddPart(Node, TMimePart(TList(Part.Body)[I]));
  end;
  
begin
  TreeView1.Items.Clear;
  AddPart(nil, Part);
end;

2001/04/27、河邦 正（GCC02240@nifty.com）
（http://homepage2.nifty.com/kht0000/、NIFTY外へ私作Componentの
公開用）
 



Original document by 河邦 正         氏 ID:(GCC02240)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。