Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2015年05月08日] [更新 2015年05月08日] Delphi サンプルプログラム集
764_Web ページを MHT 形式で保存 - CDO.Message
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + IE 11.0
764_SaveWebPage_MHT.zip [1,531 KB] 2015年05月08日版 (EXE 同梱)







01_Web ページを MHT 形式 ( 単一ファイル ) で保存  -  CDO.Message


MHT (Multipart HTML) 形式は,Multipart MIME 形式のメールと同じように,指定したウェブページを単一のファイルとして保存する方式です.CDO (Collaboration Data Objects)関係のインターフェイスを使用します.

サンプルコードは,以下のリンクの記事に掲載されているコードを利用しています.
本サンプルでは,確認のために,TEmbeddedWB コンポーネントに表示しているウェブページを保存するようにしていますが,保存対象のウェブページを表示する必要性はありません.

本サンプルのコードで保存した MHT ファイルのサイズは,保存ダイアログで保存した MHT ファイルよりもサイズが小さくなりました.何か保存していないオブジェクトがあるのかも知れません.
実際に保存した MHT ファイルを IE 11 で表示すると,ウェブページによっては,確かに表示されない部分がありました.また,表示が少し崩れるページもありました.

MHT 形式のファイルは,IE 以外のブラウザでは閲覧できません.
筆者の環境では,この MHT 形式のファイルの表示にかなりの時間がかかります.元のウェブページの内容にもよるのかも知れませんが,確認はしていません.



図1
設計時画面
図2
実行画面
  • 表示中のウェブページを保存
  • ウェブページ表示の必要性はない
図3
ウェブページを保存した結果
  • 942_TEmbeddedWB.mht が保存したファイル
  • このファイルは IE だけでしか表示できない
  • 表示完了には少し時間がかかる

リスト1
ウェブページを MHT 形式ファイル (単一ファイル) で保存
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    EmbeddedWB1: TEmbeddedWB;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  IOUtils, CDO_TLB, ADODB_TLB;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テスト用のウェブページを表示(開く)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  AURL : String;
begin
  AURL := 'http://mrxray.on.coocan.jp/Delphi/plSamples/942_TEmbeddedWB.htm';
  EmbeddedWB1.Navigate(AURL);
end;

//-----------------------------------------------------------------------------
//  ウェブページを.MHT形式のファイルで保存するルーチン
//  url      : 保存するウェブページのアドレス
//  fileName : 保存ファイル名.フルパス
//  全てのウェブページが完全に保存できる保証はない
//
//  usesにCDO_TLB, ADODB_TLBが必要
//-----------------------------------------------------------------------------
procedure SaveURLasMHT(const url: String; const fileName: String);
var
  Limsg   : IMessage;
  Liconf  : IConfiguration;
  LStream : ADODB_TLB._Stream;
begin
  Limsg  := CoMessage.Create;
  Liconf := CoConfiguration.Create;

  try
    Limsg.Configuration := Liconf;
    Limsg.CreateMHTMLBody(url, cdoSuppressNone, '', '');
    LStream := Limsg.GetStream;
    LStream.SaveToFile(fileName, adSaveCreateOverWrite);
  finally
    Limsg   := nil;
    Liconf  := nil;
    LStream := nil;
  end;
end;

//=============================================================================
//  ウェブページをMHT形式のファイルで保存
//  TPathの使用にはusesにIOUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSavePath : String;
  LFileExt  : String;
begin
  //保存ファイル名の生成
  LSavePath := TPath.GetFileName(EmbeddedWB1.LocationURL);
  LSavePath := ExtractFilePath(Application.ExeName) + LSavePath;

  //拡張子が.htm,htmlでない場合は保存ファイル名を固定にする
  //ページのタイトルだとファイル名に使用不可の文字がある場合がある
  //このあたりは工夫が必要
  //保存ダイアログで保存ファイル名を設定した方がいいかも知れない
  LFileExt  := ExtractFileExt(LSavePath);
  if (UpperCase(LFileExt) <> '.HTM') and (UpperCase(LFileExt) <> '.HTML') then begin
    LSavePath := 'WebPageMHTFile.html';
  end;

  //拡張子を.mhtに変更
  LSavePath := ChangeFileExt(LSavePath, '.mht');

  //保存
  SaveURLasMHT(EmbeddedWB1.LocationURL, LSavePath);
end;

//=============================================================================
//  Edit1のOnKeyDownイベント
//  他のウェブページのテスト用
//  ページの移動は[Back]または[Shift]+[Back](EmbeddedWB1にフォーカスがある場合)
//=============================================================================
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  AURL : String;
begin
  if Key = VK_RETURN then begin
    AURL := Trim(Edit1.Text);
    EmbeddedWB1.Navigate(AURL);
   end;
end;

end.


本サンプルでは,CDO_TLB と ADODB_TLB というユニットを使用しています.
これらのユニットは,[タイプライブラリの取り込み] で,Microsoft CDO for Windows 2000 Library から作成したものです.

ユニットの作成の際,コンポーネントラッパーを作成しないようにします.コンポーネントラッパーを作成すると,CDO_TLB.pas に TMessage というクラスができます.TMessage というクラス名は,VCL の他のユニットにもあります.
また,Delphi には ADODB.Stream を扱うためのクラスが実装されています.これも ADODB_TLB.pas 内のコードと重複する可能性があります.そこで,上のコードでは ADODB_TLB._Stream として,明示的に ADODB_TLB.pas を使用するようにしています.
マイクロソフトの記事では ADO オブジェクトとなっていますが,ADODB のことです.



図4
タイプライブラリの取り込み




02_CDO.Message 等を OleVariant 型で扱う


CDO.Message も ADODB.Stream も当然ですが,CreaeOleObject で生成して,OleVariant 型で扱うことができます.
下のコードは,そのようにしたコードです.CreateOleObject で生成する場合は,タイプライブラリの取り込みを行う必要はありません.



リスト2
ウェブページを MHT 形式ファイル (単一ファイル) で保存
uses に ComObj が必要
//-----------------------------------------------------------------------------
//  ウェブページを.MHT形式のファイルで保存するルーチン
//  url      : 保存するウェブページのアドレス
//  fileName : 保存ファイル名.フルパス
//  全てのウェブページが完全に保存できる保証はない
//
//  usesにComObjが必要
//-----------------------------------------------------------------------------
procedure SaveURLasMHT(const url: String; const fileName: String);
var
  Lobjimsg   : OleVariant;
  Lobjiconf  : OleVariant;
  LobjStream : OleVariant;
begin
  Lobjimsg   := CreateOleObject('CDO.Message');
  Lobjiconf  := CreateOleObject('CDO.Configuration');
  LobjStream := CreateOleObject('ADODB.Stream');

  try
    LObjimsg.Configuration := Lobjiconf;
    Lobjimsg.CreateMHTMLBody(url, 0, '', '');
    LobjStream := Lobjimsg.GetStream;
    LobjStream.SaveToFile(fileName, 2);
  finally
    Lobjimsg   := Unassigned;
    Lobjiconf  := Unassigned;
    LobjStream := Unassigned;
  end;
end;