Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2013年06月02日] [更新 2016年02月02日]　Delphi サンプルプログラム集
948_TEmbeddedWB コンポーネントの追加メソッド類
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + IE 11.0
TEmbeddedWB Version 14.70.0
948_TEmbeddedWB_Method.zip　[13,287 KB]　2016年02月02日版 (EXE 同梱)



  • 2015年05月01日
  • タグの contenteditable 属性の設定による編集モードの切り換えのサンプルを追加
  • 2015年05月03日
  • ウェブページの HTML コード保存とページ保存のサンプルを追加
  • 2016年01月29日
  • ウェブページを画像として保存するサンプルを追加



TEmbeddedWB コンポーネントの追加メソッド類


TEmbeddedWB コンポーネントは，Delphi 標準の TWebBrowser に比べて機能が拡張されています．
その内，追加されたメソッド類の一部の紹介を兼ねたテストサンプルです．
これらのメソッドの多くは，EwbTools.pas が提供しています．したがって，TEmbeddesWB コンポーネントを配置しなくても利用可能なコードが多くなっています．





01_IE のバージョンの取得


TEmbeddedWB コンポーネントに含まれている EwbTools の GetIEVersion と GetIEVersionMajor メソッドのテストです．IE のバージョンを取得します．


図1
設計時画面
図2
IE のバージョン文字列
図3
IE のメジャーバージョン文字列

リスト1
IE のバージョンの取得		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses EwbTools;

{$R *.dfm}

//=============================================================================
//  IEのバージョンを取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StrVer : String;
begin
  StrVer := EwbTools.GetIEVersion;
  Application.MessageBox(PChar(StrVer), 'IE バージョン');
end;

//=============================================================================
//  IEのバージョンを取得
//  メジャーバージョン番号のみ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  StrVer : String;
begin
  StrVer := IntToStr(EwbTools.GetIEVersionMajor);
  Application.MessageBox(PChar(StrVer), 'IE バージョン');
end;

end.



02_インターネットの接続確認


CheckOnlineStatus メソッドで，オンライン状態かオフライン状態かを検出します．
このメソッドは，内部で InternetGetConnectedState 関数を実行して状態を取得しています．


図4
実行例

リスト2
インターネットの接続確認		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses EwbTools;

{$R *.dfm}

//=============================================================================
//  オンラインかオフラインかの調査
//  内部ではInternetGetConnectedStateを実行している
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if EwbTools.CheckOnlineStatus then begin
    Application.MessageBox('オンライン中です', '接続状態');
  end else begin
    Application.MessageBox('オフラインです', '接続状態');
  end;
end;

end.



03_文字列を指定してブランクページを表示


AddHtmlToAboutBlank メソッドで，ブランクのページを表示します．このメソッドは，引数で指定した文字列だけを表示します．何かの理由で表示したくないウェブページがあった場合，代替えとしての注意表示に使えるかも知れません．


図5
実行結果

リスト3
文字列を指定してブランクページを表示		 
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;
    EmbeddedWB1: TEmbeddedWB;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  文字列だけのブランクページを表示
//  文字列を表示するので「ブランク」ではないが
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  EmbeddedWB1.AddHtmlToAboutBlank('Enhanced Browser 2006');
end;

end.



04_メールの新規作成


[インターネットオプション] のダイアログの，[プログラム] タブの [プログラムの設定] で設定した既定のプログラムのメールソフトを起動します．
起動するメーラ (メールソフト) は，必ずしもシステム既定のメールソフトとは限りません．


図6
実行例

リスト4
メールの新規作成		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses EwbTools;

{$R *.dfm}

//=============================================================================
//  新規作成でメールプログラムを起動
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  EwbTools.CreateNewMail;
end;

end.



05_フレームの各ページの URL を取得


フレームの操作関係メソッドを使用して，現在表示中のフレームの各ページの URL つまりアドレスを取得します．フレームは階層構造になっていますから，再帰的に検出しています．
該当ホスト以外のアドレスを除外して，広告やアフィリエイトなどのフレームを除外しています．また，全てのリンクを，別のウィンドウで開かずに，この TEmbeddesWB コンポーネントで表示するようにしています．


[備考]
ブラウザの [進む] [戻る] のキー操作は，[Shift] + [Back] または [Back] です．


図7
設計時画面
図8
フレームの URL を取得
  • 左上のボタンをクリック
  • コンボボックスに URL のリスト
  • これを選択すると，該当フレームのみを表示
図9
フレームだけを表示
  • 上の図で，右ペインのフレームのページだけを表示した結果

リスト5
フレームの各ページの URL を取得		 
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;
    EmbeddedWB1: TEmbeddedWB;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure EmbeddedWB1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
      bstrUrl: WideString);
  private
    { Private 宣言 }
    URLBase : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MSHTML_EWB, IdURI;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テスト用のウェブページを表示(開く)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.Style := csDropDownList;

  //フレームで構成されたサイトの例
//  URLBase := 'http://delfusa.main.jp/delfusafloor/technic/technic_f.html';
//  URLBase := 'http://ht-deko.com/Delphi/';
  URLBase := 'http://chokuto.ifdef.jp/urawaza/api/index.html';

  EmbeddedWB1.Navigate(URLBase);
end;

//=============================================================================
//  表示ウェブページのフレームのページのURLを取得
//  TComboBoxのItemに追加していく
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  IWebBrowser2のインスタンスから各フレームのページアドレスを再帰的に取得
  //---------------------------------------------------------------------------
  procedure SearchFrameURL(iIWeb2: IWebBrowser2);
  var
    Doc2  : IHTMLDocument2;
    Cnt   : Integer;
    i     : Integer;
    IWeb2 : IWebBrowser2;
  begin
    Doc2 := iIWeb2.Document as IHTMLDocument2;
    Cnt  := Doc2.frames.length;
    if Cnt >= 2 then begin
      //この行を削除すれば，単独のフレームのみの取得となる
      ComboBox1.Items.Add(iIWeb2.LocationURL);
      for i := 0 to Cnt - 1 do begin
        IWeb2 := EmbeddedWB1.GetFrameFromDocument(Doc2, i);
        SearchFrameURL(IWeb2);
      end;
    end else begin
      ComboBox1.Items.Add(iIWeb2.LocationURL);
    end;
  end;
  //---------------------------------------------------------------------------

var
  i     : Integer;
  IWeb2 : IWebBrowser2;
  uri   : TIdURI;
  Host  : string;
  iPos  : Integer;
begin
  if not EmbeddedWB1.DocumentLoaded then exit;

  ComboBox1.Items.Clear;
  ComboBox1.Items.Add(URLBase);
  ComboBox1.ItemIndex := 0;

  //各フレームのURLを取得
  for i := 0 to EmbeddedWB1.Doc2.frames.length - 1 do begin
    IWeb2 := EmbeddedWB1.GetFrame(i);
    SearchFrameURL(IWeb2);
  end;

  //対象のホスト以外のURL(広告やアフィリエイト等)を削除
  //TIdURIの使用にはusesにIdURIが必要
  uri := TIdURI.Create(URLBase);
  try
    Host := uri.Host;
  finally
    uri.Free;
  end;
  Sleep(10);
  for i := ComboBox1.Items.Count - 1 downto 0 do begin
    iPos := Pos(Host, ComboBox1.Items[i]);
    if (iPos <= 0) or (iPos >= Length(URLBase)) then ComboBox1.Items.Delete(i);
  end;
end;

//=============================================================================
//  EmbeddedWB1のOnNewWindow3イベント処理
//  新しいウィンドウを表示しないで，このEmbeddedWB1で表示する
//=============================================================================
procedure TForm1.EmbeddedWB1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
  bstrUrl: WideString);
begin
  EmbeddedWB1.Navigate(bstrUrl);
  Cancel := True;
end;

//=============================================================================
//  ComboBox1のOnChangeイベント処理
//  選択項目を変更したら，そのURLのページを表示
//=============================================================================
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  EmbeddedWB1.Navigate(ComboBox1.Items[ComboBox1.ItemIndex]);
end;

end.


OnBeforeNavigate2 イベントでも，ナビゲートする前にページのアドレスを取得できます．
ただし，下のサンプルコードでは，該当ホスト以外の除外処理はしていません．OnBeforeNavigate2 イベントでは，最初にナビゲートされる URL が必ずしも該当ホスト内のページとは限りません．広告等のフレームの場合もあります．


図10
OnBeforeNavigate2 使用		 

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  AURL : String;
begin
  ComboBox1.Style := csDropDownList;
  ComboBox1.Items.Clear;

  //フレームで構成されたサイトの例
  AURL := 'http://chokuto.ifdef.jp/urawaza/api/index.html';

  EmbeddedWB1.Navigate(AURL);
end;

//=============================================================================
//  EmbeddedWB1のOnBeforeNavigate2イベント処理
//  ウェブページが表示される前のイベント
//
//  これから表示するページのURL(アドレス)を取得する
//  フレームであるかのチェックのコードは省略
//  ジャンプ先のページ全て(広告やアフィリエイト)等のURLも取得する
//=============================================================================
procedure TForm1.EmbeddedWB1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  Flag : Boolean;
  i    : Integer;
begin
  Flag := False;
  for i := 0 to ComboBox1.Items.Count -1 do begin
    if CompareText(URL, ComboBox1.Items[i]) = 0 then begin
      Flag := True;
      break;
    end;
  end;
  if not Flag then ComboBox1.Items.Add(URL);
end;

//=============================================================================
//  EmbeddedWB1のOnNewWindow3イベント処理
//  新しいウィンドウを表示しないで，このEmbeddedWB1で表示する
//=============================================================================
procedure TForm1.EmbeddedWB1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
  bstrUrl: WideString);
begin
  EmbeddedWB1.Navigate(bstrUrl);
  Cancel := True;
end;

//=============================================================================
//  ComboBox1のOnChangeイベント処理
//  選択項目を変更したら，そのURLのページを表示
//=============================================================================
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  EmbeddedWB1.Navigate(ComboBox1.Items[ComboBox1.ItemIndex]);
end;



06_お気に入りやキャッシュ等の特殊フォルダの取得と操作


TEmbeddedWB コンポには，特殊フォルダのパスを取得するメソッドがいくつか用意されています．
履歴やキャッシュリストの消去もできます．
インターネットキャッシャ，クッキー，インターネット履歴の格納場所は，[460_特殊フォルダのフルパスを取得] のサンプルで使用している，CSIDL や FOLDERID (KNOWNFOLDERID) の値から取得することもできます．


図11
設計時画面
図12
マイドキュメントのフォルダ
図13
キャッシュのフォルダ
図14
お気に入りのフォルダ

リスト6
お気に入りやキャッシュ等の特殊フォルダの取得と操作		 
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;
    EmbeddedWB1: TEmbeddedWB;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure EmbeddedWB1NavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses EwbTools, ShlObj;

{$R *.dfm}

//=============================================================================
//  CSIDL値の特殊フォルダを取得して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  pDir : PChar;
  AURL : String;
begin
  pDir := EwbTools.GetSpecialFolderPath(Handle, CSIDL_MYDOCUMENTS);
  AURL := pDir;

  //指定のURLを表示(ここではローカルなHTMLファイル)
  EmbeddedWB1.Navigate(AURL);
end;

//=============================================================================
//  IEのお気に入りフォルダを取得して表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  APath : String;
begin
  APath := EwbTools.GetFavoritesPath;
  EmbeddedWB1.Navigate(APath);
  Application.MessageBox(PChar(APath), 'お気に入りのパス');
end;

//=============================================================================
//  IEのウェブページの表示履歴のフォルダを取得して表示
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  APath : String;
begin
  APath := EwbTools.GetHistoryPath;
  EmbeddedWB1.Navigate(APath);
  Application.MessageBox(PChar(APath), '履歴のパス');
end;

//=============================================================================
//  IEのウェブページの表示履歴のフォルダを取得して表示
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  APath : String;
begin
  APath := EwbTools.GetCachePath;
  EmbeddedWB1.Navigate(APath);
  Application.MessageBox(PChar(APath), 'キャッシュのパス');
end;

//=============================================================================
//  IEのクッキーの保存先フォルダを取得して表示
//=============================================================================
procedure TForm1.Button5Click(Sender: TObject);
var
  APath : String;
begin
  APath := EwbTools.GetCookiesPath;
  EmbeddedWB1.Navigate(APath);
  Application.MessageBox(PChar(APath), 'クッキーのパス');
end;

//=============================================================================
//  IEの履歴の消去
//=============================================================================
procedure TForm1.Button6Click(Sender: TObject);
begin
  EwbTools.ClearHistory;
end;

//=============================================================================
//  IEのキャッシュの消去
//=============================================================================
procedure TForm1.Button7Click(Sender: TObject);
begin
  EwbTools.ClearCache;
end;

//=============================================================================
//  IEのクッキーの消去
//=============================================================================
procedure TForm1.Button8Click(Sender: TObject);
begin
  EwbTools.ClearSessionCookies;
end;

//=============================================================================
//  各フォルダのファイルの表示を詳細表示とする
//=============================================================================
procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  hListView : HWND;
begin
  hListView := EmbeddedWB1.GetIEHandle(EmbeddedWB1, 'SHELLDLL_DefView');

  if hListView <> 0 then begin
    if CheckWin32Version(6, 0) then begin
      SendMessage(EmbeddedWB1.Handle, WM_COMMAND, $704B, 0);
    end else begin
      SendMessage(EmbeddedWB1.Handle, WM_COMMAND, $702C, 0);
    end;
  end;
end;



07_お気に入りのメニューとお気に入りの整理ダイアログの表示


[お気に入りのメニュー] と [お気に入りの整理ダイアログ] を表示するサンプルです．
[お気に入りのメニュー] は TEmbeddedWB のパッケージに含まれている TFavoritesPopup コンポーネントを使用します．[お気に入りの整理ダイアログ] は，TEmbeddedWB の ShowOrganizeFavorites メソッドを使用します．どちらも表示位置の設定が可能です．
EwbTools.ShowOrganizeFavorites(Handle); を使用すると，TEmbeddedWB コンポーネントを配置しなくても [お気に入りの整理ダイアログ] を表示できます．ただし，uses に EwbTools が必要です．


図15
設計時画面
図16
お気に入りのメニューを表示
  • 表示位置をコードで指定している
図17
お気に入りの整理ダイアログを表示
  • 表示位置をイベント内で設定している

リスト7
お気に入りのメニューとお気に入りの整理ダイアログの表示		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    FavoritesPopup1: TFavoritesPopup;
    EmbeddedWB1: TEmbeddedWB;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure EmbeddedWB1ShowDialog(Sender: TObject; h: Cardinal;
      StyleEx: Integer; OldCaption: string; var NewCaption: WideString;
      var Cancel: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [お気に入りを表示]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //位置を指定して表示
  FavoritesPopup1.Popup(Self.Left + 20, Self.Top + 70);
end;

//=============================================================================
//  [お気に入りの整理]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  EmbeddedWB1.ShowOrganizeFavorites;
end;

//=============================================================================
//  EmbeddedWB1のOnShowDialogイベント処理
//=============================================================================
procedure TForm1.EmbeddedWB1ShowDialog(Sender: TObject; h: Cardinal;
  StyleEx: Integer; OldCaption: string; var NewCaption: WideString;
  var Cancel: Boolean);
begin
  //ダイアログの表示位置を変更
  SetWindowPos(h, 0, Self.Left, Self.Top + 50, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
end;

end.



08_アドレス入力欄の履歴を消去


TE のアドレス入力欄の履歴を消去するメソッド ClearTypedUrls のテストです．


図18
消去前
図19
消去後

リスト8
アドレス入力欄の履歴を消去		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses EwbTools;

{$R *.dfm}

//=============================================================================
//  アドレス入力欄の入力履歴を消去
//  IEを再起動すると有効になる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  EwbTools.ClearTypedUrls;
end;

end.



09_隠しコマンド類の実行


いわゆる「隠しコマンド」の実行例です．関係する IE のハンドルを GetIEHandle メソッドで取得して，そのハンドル対して SendMessage でメッセージを送ります．IE のバージョンや Windows の環境によっては動作しない場合もあるようです．
ダイアログはモーダルで表示します．
ID_IE_CONTEXTMENU_ADDFAV 等の定数名は，IEConst.pas に定義がありますが，ここでは実際の値をセットして使用しています．


図20
設計時画面
図21
実行例
  • ブラウザのエクスポート・インポートの設定ダイアログを表示

リスト9
隠しコマンド類の実行		 
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;
    EmbeddedWB1: TEmbeddedWB;
    ListBox1: TListBox;
    Splitter1: TSplitter;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FrameCnt : Integer;
  end;

var
  Form1: TForm1;

implementation

uses IEConst;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  隠しコマンド類をリストボックスにセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  AURL : String;
begin
  ListBox1.Items.AddObject ('ID_IE_CONTEXTMENU_ADDFAV',       TObject(2261));
  ListBox1.Items.AddObject ('ID_IE_CONTEXTMENU_NEWWINDOW',    TObject(2137));
  ListBox1.Items.AddObject ('ID_IE_CONTEXTMENU_REFRESH',      TObject(6042));
  ListBox1.Items.AddObject ('ID_IE_F5_REFRESH',               TObject(6041));
  ListBox1.Items.AddObject ('ID_IE_FILE_ADDLOCAL',            TObject(377));
  ListBox1.Items.AddObject ('ID_IE_FILE_ADDTRUST',            TObject(376));
  ListBox1.Items.AddObject ('ID_IE_FILE_IMPORTEXPORT',        TObject(374));
  ListBox1.Items.AddObject ('ID_IE_FILE_NEWCALL',             TObject(395));
  ListBox1.Items.AddObject ('ID_IE_FILE_NEWMAIL',             TObject(279));
  ListBox1.Items.AddObject ('ID_IE_FILE_NEWPEOPLE',           TObject(390));
  ListBox1.Items.AddObject ('ID_IE_FILE_NEWPUBLISHINFO',      TObject(387));
  ListBox1.Items.AddObject ('ID_IE_FILE_NEWWINDOW',           TObject(275));
  ListBox1.Items.AddObject ('ID_IE_FILE_PAGESETUP',           TObject(259));
  ListBox1.Items.AddObject ('ID_IE_FILE_PRINT',               TObject(260));
  ListBox1.Items.AddObject ('ID_IE_FILE_PRINTPREVIEW',        TObject(277));
  ListBox1.Items.AddObject ('ID_IE_FILE_SENDDESKTOPSHORTCUT', TObject(284));
  ListBox1.Items.AddObject ('ID_IE_FILE_SENDLINK',            TObject(283));
  ListBox1.Items.AddObject ('ID_IE_FILE_SENDPAGE',            TObject(282));
  ListBox1.Items.AddObject ('ID_IE_HELP_BESTPAGE',            TObject(346));
  ListBox1.Items.AddObject ('ID_IE_HELP_ENHANCEDSECURITY',    TObject(375));
  ListBox1.Items.AddObject ('ID_IE_HELP_FAQ',                 TObject(343));
  ListBox1.Items.AddObject ('ID_IE_HELP_FEEDBACK',            TObject(345));
  ListBox1.Items.AddObject ('ID_IE_HELP_FREESTUFF',           TObject(341));
  ListBox1.Items.AddObject ('ID_IE_HELP_HELPINDEX',           TObject(337));
  ListBox1.Items.AddObject ('ID_IE_HELP_MSHOME',              TObject(348));
  ListBox1.Items.AddObject ('ID_IE_HELP_NETSCAPEUSER',        TObject(351));
  ListBox1.Items.AddObject ('ID_IE_HELP_ONLINESUPPORT',       TObject(344));
  ListBox1.Items.AddObject ('ID_IE_HELP_PRODUCTUPDATE',       TObject(342));
  ListBox1.Items.AddObject ('ID_IE_HELP_SEARCHWEB',           TObject(347));
  ListBox1.Items.AddObject ('ID_IE_HELP_STARTPAGE',           TObject(350));
  ListBox1.Items.AddObject ('ID_IE_HELP_VERSIONINFO',         TObject(336));
  ListBox1.Items.AddObject ('ID_IE_HELP_VISITINTERNET',       TObject(349));
  ListBox1.Items.AddObject ('ID_IE_HELP_WEBTUTORIAL',         TObject(338));

  //テスト用のウェブページを表示
  AURL := 'http://mrxray.on.coocan.jp/index.htm';
  EmbeddedWB1.Navigate(AURL);
end;

//=============================================================================
//  選択したリストボックスの隠しコマンドを実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AIndex   : Integer;
  IEHandle : HWND;
  CmdID    : Integer;
begin
  AIndex := ListBox1.ItemIndex;
  if AIndex < 0 then exit;

  if Pos('CONTEXTMENU', ListBox1.Items[AIndex]) > 0 then begin
    IEHandle := EmbeddedWB1.GetIEHandle(EmbeddedWB1, 'Internet Explorer_Server');
  end else begin
    IEHandle := EmbeddedWB1.GetIEHandle(EmbeddedWB1, 'Shell DocObject View');
  end;
  if IEHandle = 0 then exit;

  CmdID := Integer(ListBox1.Items.Objects[AIndex]);
  SendMessage(IEHandle, WM_COMMAND, CmdID, 0);
end;

end.



10_編集モードの切り換え  -  DesignMode プロパティ


DesignMode プロパティ使用すると，表示中のブラウザのページを編集できます．


図22
ウェブページを表示
図23
編集結果例
  • 左の目次部分を削除して，[目次を非表示] のボタンも削除
  • ダウンロードの画像を選択中

リスト10
TEmbeddedWB の DesignMode プロパティによる編集モードの切り換え		 
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;
    EmbeddedWB1: TEmbeddedWB;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$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;

//=============================================================================
//  編集モードの切り替え
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  EmbeddedWB1.DesignMode := not EmbeddedWB1.DesignMode;
  if EmbeddedWB1.DesignMode then begin
    Button1.Caption := '編集終了';
  end else begin
    Button1.Caption := '編集開始';
  end;
end;

end.



11_編集モードの切り換え  -  タグの contenteditable 属性


編集モードの切り換えは，タグ単位で操作できます．
それには，タグ要素の contenteditable 属性の値を設定します．
以下のコードは，<body> タグの contenteditable 属性を操作しています．したがって，結果的に上のサンプルプログラムと同じ動作となります．		 


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;
    EmbeddedWB1: TEmbeddedWB;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MSHTML_EWB;

{$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;

//=============================================================================
//  タグのcontenteditable属性設定による編集モードの切り替え
//  usesにMSHTML_EWBが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LAttribute   : WideString;
  LiElementCol : IHTMLElementCollection;
  LiElement    : IHTMLElement;
  LiResult     : String;
begin
  if EmbeddedWB1.Doc3 = nil then exit;

  //対象の属性の名前
  LAttribute   := 'contenteditable';

  LiElementCol := EmbeddedWB1.Doc3.getElementsByTagName('body');
  LiElement    := LiElementCol.item(0, 0) as IHTMLElement;

  //現在の属性の設定を取得
  LiResult := String(LiElement.getAttribute(LAttribute, 0));
  //指定属性の設定がなければ設定
  if (LiResult = 'inherit') then begin
    LiElement.setAttribute(LAttribute, 'true', 0);
    Button1.Caption := '編集終了';
  //指定属性の設定が存在する場合は，その属性を削除
  end else begin
    LiElement.removeAttribute(LAttribute, 0);
    Button1.Caption := '編集開始';
  end;
end;

end.


上のコードを実行して，編集モードにすると，<body> タグ属性値が以下のようになります． 


<body background="../../Images/Wal_012.gif">

   ↓ 属性を追加．<body>タグ内を編集可能にする

<body contenteditable=true background="../../Images/Wal_012.gif">



12_ウェブページの HTML コードの保存


現在 TEmbeddedWB で表示しているウェブページの HTML コードを保存するサンプルです．
TEmbeddedWB.DocumentSource の値を保存した場合と，TEmbeddedWB.SaveToFile メソッドで直接保存した場合を比較してみました．


図24
実行時画面

下図が保存結果をテキストエディタで表示した図です．
最初の図は TEmbeddedWB.DocumentSource の値を保存した場合です．<!doctype> タグが保存されていません．タグの文字も大文字になっています．マイクロソフト仕様といったところでしょうか．
次の図は，TEmbeddedWB.SaveToFile メソッドで保存した場合です．サーバに UP してあるままの HTML コードとなっています．

TEmbeddedWB コンポーネントには，この他，以下のような，特定のフレームの HTML コードだけを保存するメソッド類も実装されています．

  • SaveToFile
  • SaveToStream
  • SaveToStrings
  • SaveFrameToFile
  • SaveFrameToStream
  • SaveFrameToStrings


図25
TEmbeddedWB.DocumentSource の値を保存した場合
図26
TEmbeddedWB.SaveToFile メソッドで保存した場合

リスト11
ウェブページの HTML コードの保存		 
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;
    EmbeddedWB1: TEmbeddedWB;
    Button2: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  IOUtils;

{$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;

//=============================================================================
//  ウェブページのHTMLコードの保存
//  タグは保存されない
//  タグ名は大文字になる
//  コードの整形はマイクロソフト方式(?)
//
//  TWebBrowserにはDocumentSourceプロパティはない
//  TPathの使用にはusesにはIOUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LHtmlText : String;
  LStrList  : TStringList;
  LSavePath : String;
begin
  //現在表示中のウェブページのHTMLコードを取得
  LHtmlText := EmbeddedWB1.DocumentSource;

  LStrList := TStringList.Create;
  try

    //保存ファイル名の生成
    LSavePath := TPath.GetFileName(EmbeddedWB1.LocationURL);
    LSavePath := ExtractFilePath(Application.ExeName) + LSavePath;

    //保存
    LStrList.Text := LHtmlText;
    LStrList.SaveToFile(LSavePath);
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  ウェブページのHTMLコードの保存
//  タグも保存される
//  HTMLコードは元のままで整形なし
//
//  TWebBrowserにはSaveToFileメソッドはない
//  TPathの使用にはusesにはIOUtilsが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSavePath : String;
begin
  //保存ファイル名の生成
  LSavePath := TPath.GetFileName(EmbeddedWB1.LocationURL);
  LSavePath := ExtractFilePath(Application.ExeName) + LSavePath;

  //現在表示中のウェブページのHTMLコードを保存
  EmbeddedWB1.SaveToFile(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.



13_ウエブページをダイアログを表示して保存


保存ダイアログを使用すると，HTML コードだけではなく，いろいろな形式で保存できます．
TEmbeddedWB コンポーネントには，SaveDialog メソッドがあります．これを使用して保存ダイアログを表示しています．
ダイアログの [ファイル名] の初期値は，ウェブページの <title> タグの値になります．下のコードでは，この <title> タグの値を変更して，ウェブページのファイル名にしています．


図27
保存可能な [ファイルの種類]

リスト12
ウエブページをダイアログを表示して保存		 
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;
    EmbeddedWB1: TEmbeddedWB;
    Edit1: TEdit;
    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;

{$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;

//=============================================================================
//  保存ダイアログを表示してウェブページを保存
//  保存名のデフォルトは，HtMLコードの<title>タグの値
//
//  TPathの使用にはusesにはIOUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSavePath : String;
  LTitle    : String;
begin
  //保存ファイル名の生成
  //拡張子はフィルタを選択すると自動的に変わるのでなしにする
  LSavePath := TPath.GetFileName(EmbeddedWB1.LocationURL);
  LSavePath := ChangeFileExt(LSavePath, '');

  //titleタグの値なのでHTMLファイル名に変更
  LTitle := EmbeddedWB1.Doc2.title;
  EmbeddedWB1.Doc2.title := ExtractFileName(LSavePath);
  try
    EmbeddedWB1.SaveDialog;
  except
  end;
  //titleタグの値を元に戻しておく
  EmbeddedWB1.Doc2.title := LTitle;

  //OLECMDEXECOPT_DONTPROMPTUSERは古い形式のダイアログ
  //第3引数にファイル名(パスなし)を指定するとファイル名の欄にセットされる
  //EmbeddedWB1.ExecWB( OLECMDID_SAVEAS, OLECMDEXECOPT_DONTPROMPTUSER, pvIn);
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.



14_ウェブページの完全保存  -  ダイアログの SendKeys による操作


IE の [Web ページ，完全] に相当するウェブページの保存サンプルです．
完全保存すれば，オフラインでも，該当するウエブページをブラウザで表示できます．
上のサンプルで，[ファイルの種類] をそれにすれば，完全保存となりますが，本サンプルではマウスやキーボードでダイアログを操作しなくても保存できるようにしています．

IE 関係のオブジェクトには，ダイアログを表示しないでウェブページを保存するメソッドやプロパティ類はありません．そこで，ローカルフックを利用して，ダイアログが表示されたら，キー操作をダイアログに送っています．このキー操作の送信に WSH (Windows Script Host) の WshShell オブジェクトを使用しています．



[備考]
下のコードでは，一瞬ですがダイアログが表示されます．
ダイアログを非表示にしてしまうとキー操作はできません．そこで，ダイアログの表示位置を画面上では見えない位置に表示する方法が考えられます．また，保存の確認ダイアログを表示されないようにするには，同名のファイルが存在したら，あらかじめ削除しておく方法も考えられます．


図28
設計時画面

下の図は，実際にウェブページを本サンプルの EXE があるフォルダに保存した結果です．
[942_TEmbeddedWB.files] フォルダには，ウェブページで使用されていた JavaScript のコード，画像，スタイルシート等が保存されています．

942_TEmbeddedWB.htm は対象のウェブページの HTML ファイルです．元の HTML コードの画像等のリンク先が，[942_TEmbeddedWB.files] フォルダ内のファイルに変更されて保存されています．
ただし，リンク先が相対 URL で記述された画像が，一部，相対リンクのままで保存されていませんでした．その場合，保存した HTML ファイルをブラウザで表示しても，画像は表示されません．また，ページ内のアンカーが絶対 URL に変換はされてはいましたが，元のサーバ上のアドレスになっているのがありました．

この現象は，前項のサンプルで，ダイアログから指定して保存した場合も同じでした．




図29
ウェブページを保存した結果
  • 942_TEmbeddedWB.files にページ内の JavaScript, 画像，スタイルシート等が保存されている
  • 942_TEmbeddedWB.htm は HTML コードだけ

リスト13
ウェブページをダイアログの遠隔操作で完全保存
1 つのウェブページに対して，1 つのファイルと 1 つのフォルダができる		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    EmbeddedWB1: TEmbeddedWB;
    Edit1: TEdit;
    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, IWshRuntimeLibrary_TLB, Clipbrd;

{$R *.dfm}

var
  MsgHook   : HHOOK;
  LSavePath : WideString;

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  WH_CALLWNDPROCフックのコールバック関数
//  ダイアログのWM_ACTIVATEメッセージを処理
//  ダイアログにキー操作を送ることでダイアログの項目値を設定
//  [Web ページ，完全]で保存する
//
//  ここではMsg : PMsgではなくMsg: PCWPStructにして，wParamの値を受け取る
//  Windowsのダイアログのクラス名は#32770
//  TIWshShell_Classの使用にはusesにIWshRuntimeLibrary_TLBが必要
//  Clipboardの使用にはusesにClipbrdが必要
//-----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall;
var
  LpMsgStruct : PCWPStruct;
  LhWindow    : HWND;
  LWshShell   : TIWshShell_Class;
begin
  if (code < 0) then begin
    Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
    exit;
  end;

  if (code = HC_ACTION) then begin
    LpMsgStruct := PCWPStruct(LPar);
    LhWindow := LpMsgStruct^.hwnd;
    if GetWindowClassNameStr(LhWindow) = '#32770' then begin
      if LpMsgStruct^.message = WM_ACTIVATE then begin
        if LpMsgStruct^.wParam = 1 then begin
          LWshShell := TIWshShell_Class.Create(nil);
          try
            //[ファイル名]に移動して，全て選択して現在の値をクリア
            LWshShell.SendKeys('%N');
            LWshShell.SendKeys('^A');
            LWshShell.SendKeys('{DELETE}');

            //SendKeysだと日本語が化けるのでクリップボード経由でファイル名をセット
            Clipboard.AsText := LSavePath;
            LWshShell.SendKeys('^V');

            //[保存]ボタンをクリック
            LWshShell.SendKeys('%S');
            //[名前を付けて保存確認]ダイアログ対策
            //このダイアログを表示しないようにするには，既存のファイルを削除しておく
            LWshShell.SendKeys('%Y');
          finally
            FreeAndNil(LWshShell);
          end;
        end;
      end;
    end;
  end;

  Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
end;

//=============================================================================
//  フォーム生成時の処理
//  テスト用のウェブページを表示(開く)
//=============================================================================
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形式のファイルで保存
//  TPathの使用にはusesにIOUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //保存ファイル名の生成
  //TPathの使用にはusesにはIOUtilsが必要
  LSavePath := TPath.GetFileName(EmbeddedWB1.LocationURL);
  LSavePath := ExtractFilePath(Application.ExeName) + LSavePath;

  //ダイアログのローカルフック開始
  //フックはダイアログの遠隔操作用
  MsgHook := SetWindowsHookEx(WH_CALLWNDPROC, GetMsgProc, 0, GetCurrentThreadID);
  try
    //保存ダイアログを表示
    EmbeddedWB1.SaveDialog;
  except
  end;
  //ダイアログのフック終了
  UnHookWindowsHookEx(MsgHook);
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.


上のコードでは，[ファイル名] の入力欄に移動した時に，全てを選択して削除していますが，実際には必要ありません．[ファイル名] の入力欄に入力フォーカスが移動すると，自動的に全て選択の状態になります．

保存ダイアログで単一ファイルの .mht を選択する場合は，キー操作の部分を次のように変更することで可能です．保存ファイル名には拡張子を付けないでセットします．拡張子は自動で付加されます．拡張子 .mht を付けてしまうと保存できません．

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



リスト14
ウェブページを，ダイアログの遠隔操作で，MHT 形式のファイルとして保存		 
          LWshShell := TIWshShell_Class.Create(nil);
          try
            //[ファイルの種類]に移動して，コンポボックスを操作
            LWshShell.SendKeys('%T');
            LWshShell.SendKeys('{DOWN}');
            LWshShell.SendKeys('{UP}');
            LWshShell.SendKeys('{UP}');
            LWshShell.SendKeys('{DOWN}');

            //[ファイル名]に移動
            LWshShell.SendKeys('%N');

            //SendKeysだと日本語が化けるのでクリップボード経由でファイル名をセット
            //拡張子は付けないこと．保存の際に自動で付加される
            Clipboard.AsText := ChangeFileExt(LSavePath, '');
            LWshShell.SendKeys('^V');

            //[保存]ボタンをクリック
            LWshShell.SendKeys('%S');
            //[名前を付けて保存確認]ダイアログ対策
            //このダイアログを表示しないようにするには，既存のファイルを削除しておく
            LWshShell.SendKeys('%Y');
          finally
            FreeAndNil(LWshShell);
          end;


WshShell オブジェクトは，以下のように，CreateOleObject で生成して，OleVariant 型で扱うこともできます．



リスト15
ウェブページをダイアログの遠隔操作で完全保存
WshShell オブジェクトを CreateOleObject で生成して使用する場合 (uses に ComObj が必要)		 
          LWshShell := CreateOleObject('WScript.Shell');
          try
            //[ファイル名]に移動
            LWshShell.SendKeys('%N');

            //SendKeysだと日本語が化けるのでクリップボード経由でファイル名をセット
            Clipboard.AsText := LSavePath;
            LWshShell.SendKeys('^V');

            //[保存]ボタンをクリック
            LWshShell.SendKeys('%S');
            //[名前を付けて保存確認]ダイアログ対策
            //このダイアログを表示しないようにするには，既存のファイルを削除しておく
            LWshShell.SendKeys('%Y');
          finally
            LWshShell := Unassigned;
          end;


本サンプルで使用している WSH のオブジェクトは，[コンポーネントのインポート] [タイプライブラリの取り込み] で，Windows Script Host Object Model から IWshRuntimeLibrary_TLB.pas を作成して使用しています．ユニットの作成の際，コンポーネントラッパーの作成をしています．パッケージには登録していません．
CreateOleObject で WshShell オブジェクトを生成して使用する場合は，タイプライブラリの取り込みを行う必要はありません．



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

[備考]
村松氏が開発した Sendkeys という関数があります．また SendKey32 というのもありますが，どちらも，上のコードで使用する場合に限って言えば，ダイアログへのキー送信はできません．
Delphi の Keyboard.pas にも SendKeys が実装されています．





15_表示中のウェブページを画像として保存


TEmbeddedWB コンポーネントには，表示中のウェブページを画像にして保存するメソッド類が用意されています．それらを使用したサンプルです．表示中のウェブページは，表示中の領域だけを保存するか，ページ全体を画像として保存するかを指定できるようにしてみました．

フレームで構成されたウェブページにも対応していますが，縦分割形式だけの対応です．横分割のフレームがあるウェブページは，正しく取得できない場合があります．



[備考 1]
ウェブページ全体を画像として取得するのであれば，以下の参考リンクのコードで可能です．必要であればフレームに対応したコードを追加します．
最初のリンクのコードは，ControllInterface を ControlInterface に修正して，uses に ActiveX を追加します．

[備考 2]
掲載している画像の枠線は，筆者が追加描画したものです．サンプルには，取得した画像に枠線を描画するコードはありません．


図31
設計時画面
  • 白い部分が_TEmbeddedWB コンポーネント
図32
実行してウェブページを表示
  • TEmbeddedWB で表示しているウェブページを画像にして保存する
  • ウェブページのキャプチャとも言える
図33
表示中の領域だけを画像にして保存
  • この画像は，保存した画像を縮小したもの
図34
ウェブページ全体を画像にして保存
  • この画像は，保存した画像を縮小したもの

リスト16
TEmbeddedWB コンポーネントで表示中のウェブページを画像にして保存
フレーム対応コード付き (縦分割形式のみ対応)		 
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;
    Edit1: TEdit;
    Button1: TButton;
    EmbeddedWB1: TEmbeddedWB;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    function GetImageFromBrowser(ABrowser: TEmbeddedWB;
      AFileName: string; IsAll: Boolean=False): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  EwbTools,
  MSHTML_EWB,
  HTTPApp,
  IOUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled := False;
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/Others/FindComponent.htm';
end;

//=============================================================================
//  Edit1のURLのウェブページをTEmbeddedWBコンポーネントに表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  EmbeddedWB1.Navigate(Trim(Edit1.Text));
  Button2.Enabled := True;
end;

//=============================================================================
//  表示中のウェブページを画像として保存
//  UnixPathToDosPathの使用には，usesにHTTPAppが必要
//  TPathの使用には，usesにIOUtilsが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LUrl      : string;
  LFileExt  : string;
  LFileName : string;
begin
  //保存する画像ファイル名の生成
  LUrl      := UnixPathToDosPath(EmbeddedWB1.LocationURL);
  LFileExt  := '.bmp';
  LFileName := ChangeFileExt(ExtractFileName(LUrl), LFileExt);

  //ファイル名部分が空文字なら仮の名前を付ける
  if TPath.GetFileNameWithoutExtension(LFileName) = '' then begin
    LFileName := 'WebPage' + LFileExt;
  end;

  //ファイル名として使用可能かをチェック
  //バス名のチェックは省略
  if TPath.HasValidFileNameChars(LFileName, False) then begin
    LFileName := ExtractFilePath(Application.ExeName) + LFileName;
  end else begin
    LFileName := ExtractFilePath(Application.ExeName) + 'WebPage' + LFileExt;
  end;

  //表示中のウェブページをLFileNameの名前の画像として保存
  GetImageFromBrowser(EmbeddedWB1, LFileName, CheckBox1.Checked);
end;

//-----------------------------------------------------------------------------
//  TEmbeddedWBで表示中のウェブページを画像にして保存するルーチン
//
//  ABrowser  : TEmbeddedWB
//  AFileName : 保存ファイル名のフルパス
//              ビットマップで保存する場合は，拡張子を.bmpとする
//              JPEG 画像で保存する場合は，拡張子を.jpgとする
//  IsAll     : Falseの時はTEmbeddedWBで表示されている部分だけを保存
//              Trueの時はTEmbeddedWBで表示中のページ全体を保存
//
//  ページ全体を保存する場合
//  (1) 当サイトのページのように，横幅の表示を決め打ちにしている場合，ページ幅
//      が完全に表示されていないと，見えていない右端部分が保存されない
//      具体的には，横スクロールバー(水平するクローバー)が表示されていない状態
//      にする
//  (2) スクロールバー(特に垂直方向のスクロールバー)が表示状態で保存された時は，
//      ABrowser.ControlInterface.Heightの値を少し大きめにする
//
//  本ルーチンの使用にはusesにEwbTools,MSHTML_EWBが必要
//-----------------------------------------------------------------------------
function TForm1.GetImageFromBrowser(ABrowser: TEmbeddedWB;
  AFileName: string; IsAll: Boolean=False): Boolean;

  //---------------------------------------------------------------------------
  //  IWebBrowser2のインスタンスから各フレームを再帰的に調査
  //  scrollHeightの最大値を取得して引数のAHeightに返す
  //---------------------------------------------------------------------------
  procedure SearchFrameURL(iIWeb2: IWebBrowser2; var AHeight: Integer);
  var
    LDoc2     : IHTMLDocument2;
    LCnt      : Integer;
    LIWeb2    : IWebBrowser2;
    LElement2 : IHTMLElement2;
    LTempInt  : Integer;
    i         : Integer;
  begin
    try
      LDoc2     := iIWeb2.Document as IHTMLDocument2;
      LElement2 := LDoc2.body as IHTMLElement2;
      LTempInt  := LElement2.scrollHeight;
      if LTempInt > AHeight then begin
         AHeight := LTempInt;
      end;

      LCnt  := LDoc2.frames.length;
      if LCnt >= 2 then begin
        for i := 0 to LCnt - 1 do begin
          LIWeb2    := EmbeddedWB1.GetFrameFromDocument(LDoc2, i);
          LElement2 := (LIWeb2.Document as IHTMLDocument2).body as IHTMLElement2;
          LTempInt  := LElement2.scrollHeight;
          if LTempInt > AHeight then begin
            AHeight := LTempInt;
          end;

          SearchFrameURL(LIWeb2, AHeight);
        end;
      end;
    except
    end;
  end;
  //---------------------------------------------------------------------------

var
  LWebBrowser : IWebBrowser2;
  LElement2   : IHTMLElement2;
  LHeight     : Integer;
  LWidth      : Integer;
  LFileExt    : string;
  i           : Integer;
begin
  Result := False;

  if IsAll then begin
    LockWindowUpdate(ABrowser.Handle);

    //表示ページのスクロール範囲を取得
    LElement2 := ABrowser.Doc2.body as IHTMLElement2;
    LHeight   := LElement2.scrollHeight;
    LWidth    := LElement2.scrollWidth;

    //フレームを使用したウェブページの場合
    //フレームがないウェブページであれば，この処理は不要
    //ABrowser.FrameCountだと処理が止まるウェブページがある
    //止まると,フォームが閉じる時に継続実行される
    for i := 0 to ABrowser.Doc2.frames.length - 1 do begin
      LWebBrowser := ABrowser.GetFrame(i);
      SearchFrameURL(LWebBrowser, LHeight);
    end;

    //TEmbeddedWBのサイズを変更する
    ABrowser.ControlInterface.Height := LHeight + GetSystemMetrics(SM_CYHSCROLL) +7;
    ABrowser.ControlInterface.Width  := LWidth + GetSystemMetrics(SM_CXHSCROLL) + 7;
  end else begin
    LHeight := ABrowser.Height;
    LWidth  := ABrowser.Width;
  end;

  LFileExt := UpperCase(ExtractFileExt(AFileName));
  if LFileExt = '.JPG' then begin
    //TEmbeddedWB.GetJpegFromBrowserを使用してJPEG画像で保存
    //JPEGで保存する際に，画像サイズを指定できるが，ここでは元のサイズと同じ
    Result := ABrowser.GetJpegFromBrowser(AFileName,
                                          LHeight,
                                          LWidth,
                                          LHeight,
                                          LWidth);
  end else
  if LFileExt = '.BMP' then begin
    //EwbTools.GetBmpFromBrowserを使用してビットマップ画像で保存
    Result := EwbTools.GetBmpFromBrowser(ABrowser.Document,
                                         ABrowser.Handle,
                                         LWidth,
                                         LHeight,
                                         AFileName);
  end;

  if IsAll then begin
    //ABrowserの位置とサイズを元に戻す
    //AlignがalClientではない場合は，元の位置とサイズを退避しておいて戻す
    ABrowser.Align := alClient;
    LockWindowUpdate(0);
  end;
end;

end.



16_TEmbeddedWB コントロールのキャプチャ


表示中の領域だけを画像にすることは，TEmbeddedWB コントロールのキャプチャに相当します．
ウィンドウハンドルを持つコントロールであれば．次のコードのように，コントロールのウィンドウハンドルからデバイスコンテキストを取得してキャプチャできます．

このサンプルコードは，一般的なスクリーンキャプチャの方法です．したがって，前項のサンプルと違って，他のウィンドウが上に重なっている部分は，そのウィンドウの画像となります．
ただし，下に示すコードでは，Button2 クリックと同時にキャプチャを開始していますから，そのようなことはありません．Button2 が，上のサンプルのフォームに配置しているのであれば，特別なことをしない限り，Button2 をクリックすれば TEmbeddedWB 全体が表示されます．



リスト17
TEmbeddedWB コンポーネントのキャプチャ		 
//=============================================================================
//  TEmbeddedWBコントロールのキャプチャ
//  ウィンドウハンドルを持つコントロールの一般的なキャプチャ方法
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);

//CAPTUREBLTは少なくともDelphi XE以前にはないので定義
const
  CAPTUREBLT = $40000000;
var
  LTargetWnd  : HWND;
  LWindowHDC  : HDC;
  LTargetRect : TRect;
  LbmpOrigin  : TBitmap;
begin
  //TEmbeddedWBコントロールのハンドルを取得
  LTargetWnd := EmbeddedWB1.Handle;
  //そのウィンドウのデバイスコンテキストを取得
  LWindowHDC := GetWindowDC(LTargetWnd);

  //キャプチャ対象ウィンドウのサイズと位置を取得
  GetWindowRect(LTargetWnd, LTargetRect);

  //キャプチャーした画像を格納するビットマップを作成
  LbmpOrigin             := TBitmap.Create;
  LbmpOrigin.PixelFormat := pf32bit;
  LbmpOrigin.Width       := LTargetRect.Right  - LTargetRect.Left;
  LbmpOrigin.Height      := LTargetRect.Bottom - LTargetRect.Top;

  try
    //スクリーンの矩形領域をビットマップ(のCanvasに)描画
    BitBlt(LbmpOrigin.Canvas.Handle,
           0,
           0,
           LTargetRect.Right  - LTargetRect.Left,
           LTargetRect.Bottom - LTargetRect.Top,
           LWindowHDC,
           0,
           0,
           SRCCOPY or CAPTUREBLT);

    //ビットマップを保存       
    LbmpOrigin.SaveToFile('WebControl.bmp');
  finally
    //解放処理
    FreeAndNil(LbmpOrigin);
    ReleaseDC(LTargetWnd, LWindowHDC);
  end;
end;