Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年04月17日] [更新 2016年01月19日] Delphi サンプルプログラム集
940_TWebBrowser と IE ( インターネット・エクスプローラ )
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + IE 8.0 (一部 IE 11)
940_TWebBrowserAndIE.zip [10,998 KB] 2016年01月19日版 (EXE 同梱)



  • 2012年02月15日
  • 記事の構成を変更.一部を除いて TShell を使用しないコードに変更
  • 項目内でのサンプルを別項目でサンプルとした
  • 2012年04月06日
  • ダイアログ形式でウェブページを表示するサンプルを追加
  • 2012年07月31日
  • 64 ビット版アプリでの浮動小数点演算エラー回避方法の文章を追加
  • 2015年02月20日
  • IE のバージョンの取得方法が IE 10 以降で変更になったので,その修正




TWebBrowser と IE ( インターネット・エクスプローラ )


TWebBrowser と IE (InternetExplorer) オブジェクトの基本的な操作のサンプルです.

Delphi の TWebBrowser というコンポーネント (コントロール) を使用すると,Web ブラウザの機能を実現できます.これは InternetExplorer (IE)オ ブジェクトに対する操作を意味しています.このページの内容は,主にこの IE オブジェクトの生成と起動のテストとなっています.

このページのサンプルは,Windows XP で作成した EXE は Windows Vista, 7 で動作しますが,逆の場合は正常動作しない場合あります.また,動作に管理者権限が必要なサンプルもあります.



TShell コンポーネントを使用しているサンプルがあります.以下を参考にしてください.





01_64 ビット版アプリにおける浮動小数点演算エラーの回避方法


Delphi XE2 の 64 ビット版のアプリで  TWebBrowser を使用する場合,いままで使用してきた Set8087CW では 64 ビットの浮動小数点演算の例外を無視することはできません.Math.pas 内の SetExceptionMask 関数を使用すると,浮動小数点のエラーを回避してくれます.この関数は,32 ビットと 64 ビットのどちらでも使用可能となっています.

uses に Math を追加して,例えば以下のように使用します.SetExceptionMask による設定は,プロセス内でのみ有効です.システム全体での設定を変更することはできません.最後に,アプリケーションのメインフォームの OnDestroy 等で元の設定に戻しておきます.
この関数は Delphi 6 から実装されています.


  //以下のコードは,ueseにMathが必要
  //TFPUExceptionMaskはMathで定義されている
  //したがって,TFPUExceptionMaskを使用する前のuses部にMathが必要

  var
    SaveFPUMask : TFPUExceptionMask;


  //現在の設定を退避
  SaveFPUMask := Math.GetExceptionMask;

  //全ての浮動小数点演算の例外を無視する
  Math.SetExceptionMask([exInvalidOp,
                         exDenormalized,
                         exZeroDivide,
                         exOverflow,
                         exUnderflow,
                         exPrecision]);

  //各種処理コード

  //元の設定に戻す
  Math.SetExceptionMask(SaveFPUMask);





02_TWebBrowser で Web ページを表示


このサンプルは HTMLファイルを表示するもっとも基本的なテストです.
設計時に TWebBrowser を配置すると,その枠は Ctrl3D 相当ではなくフラットになっています.実行してもフラットですが,HTML ファイルを表示すると Ctrl3D 相当の枠になります.これは TWebBrowser が一種のコンテナコントロールとなっているためです.つまり,TWebBrowser に表示したオブジェクト,このテストの場合は IE の枠が Ctrl3D となっているためです.


図1
設計時画面
図2
実行開始画面
  • IE オブジェクトはまだ表示されていない
図3
添付の HTML ファイルを表示
  • 枠が Ctrl3D スタイルになっている

リスト1
TWebBrowser で Web ページを表示する基本コード
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
end;

//=============================================================================
//  TWebBrowserは,設計時Formに配置した時はCtrl3D相当の表示がFalseになっている
//  がNavigateメソッドを実行すると3Dになる
//  実際にはTWebBrowserはコンテナコントロールなのでTWebBrowserそのものが3Dにな
//  るわけではない.コンテナ上のIEが3Dになる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //指定のURLを表示
  //IEオブジェクトが(生成されていなれければ)生成される
  //そのIEがHTMLファイルを表示する
  WebBrowser1.Navigate(Edit1.Text);
end;

end.




03_HTML コードを直接セットして表示


IE オブジェクトに直接 HTML コードをコードでセットして表示することもできます.その例です.
  • TStringList に格納してそのテキストを表示
  • 実行時に HTML コードを生成して表示
  • TMemoryStrem に格納してある HTML コードを表示
の3つのテストです.そのうち 1 つは,直接 IE オブジェクトに対して操作しています.


図4
設計時画面
図5
Button1 クリック
  • <BODY> 部の HTML コードを TStringList から読み出して表示
図6
Button2 クリック
  • 実行時に <BODY> 部の HTML コードを作成して表示
図7
Button3 クリック
  • 実行時に,<HEAD> 部を含めた全 HTML コードを表示する場合
  • TMemoryStream に格納されている HTML コードを表示
  • 結果は Button1 と同じだが,<HEAD> 部が違うので文字サイズが異なっている

リスト2
実行時に HTML コードを作成して表示
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses  MSHTML, ActiveX;

{$R *.dfm}

//=============================================================================
//  HTMLコードの表示
//  TStringListに格納してあるコードを表示する場合
//  TWebBrowserに表示するドキュメントは,WebBrowser1.Documentとなっているが,
//  IHTMLCocument2にキャストしないと取得できない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SL : TStringList;
begin
  //IEオブジェクトを生成
  //about:blankは表示のクリアとしても利用できる
  WebBrowser1.Navigate('about:blank');
  //生成完了まで待つ
  while WebBrowser1.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //指定のHTMLコードを表示(ここではローカルなHTMLファイル)
  SL := TStringList.Create;
  try
    SL.LoadFromFile('Delphi_Oracle.htm');

    if Assigned(WebBrowser1.Document) then begin
      //TWebBrowserに表示(IEオブジェクトに表示)
      //outerHTMLではエラーとなる
      (WebBrowser1.Document as IHTMLDocument2).body.innerHTML := SL.Text;
    end;
  finally
    SL.Free;
  end;
end;

//=============================================================================
//  HTMLコードの表示
//  実行時にHTMLコードを生成する場合
//  TWebBrowserに表示するドキュメントは,WebBrowser1.Documentとなっているが,
//  IHTMLCocument2にキャストしないと取得できない
//
//  このコードでは,IEのオブジェクトを取得してコードをセットしている
//  WebBrowser1がIEObjになった以外はButton1Clickと同じ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  SL       : TStringList;
  IEObj    : InternetExplorer;
  HTMLDoc2 : IHTMLDocument2;
begin
  //IEのオブジェクトを取得
  //実際にはWebBrowser1のままで各種の操作ができる
  IEObj := WebBrowser1.Application as InternetExplorer;

  //about:blankは表示のクリアとしても利用できる
  WebBrowser1.Navigate('about:blank');
  //完了まで待つ
  while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //HTMLコードを作成
  SL := TStringList.Create;
  try
    SL.Add('<html>');
    SL.Add('<center>');
    SL.Add('Delphiの神託');
    SL.Add('The Oracle at Delphi');
    SL.Add('</center>');
    SL.Add('</html>');

    if Assigned(IEObj.Document) then begin
      //TWebBrowserに表示(IEオブジェクトに表示)
      HTMLDoc2 := IEObj.Document as IHTMLDocument2;
      HTMLDoc2.body.innerHTML := SL.Text;
    end;
  finally
    SL.Free;
  end;
end;

//=============================================================================
//  HTMLコードの表示
//  TMemoryStream内のHTMLコードを表示する場合
//  TWebBrowserに表示するドキュメントは,WebBrowser1.Documentとなっているが,
//  IHTMLCocument2にキャストしないと取得できない
//
//  このコードでは,一度TStrigListに読み込んだものを更にTMemoryStreamで読み込
//  んでいる
//
//  IPersistStreamInitの使用にはusesにActiveXが必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  SL         : TStringList;
  AStream    : TMemoryStream;
  PersStream : IPersistStreamInit;
begin
  //IEオブジェクトを生成
  //about:blankは表示のクリアとしても利用できる
  WebBrowser1.Navigate('about:blank');
  //完了まで待つ
  while WebBrowser1.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //TMemoryStreamにHTMLコードを読み込む
  SL      := TStringList.Create;
  AStream := TMemoryStream.Create;
  try
    SL.LoadFromFile('Delphi_Oracle.htm');
    SL.SaveToStream(AStream);
    AStream.Seek(0, soFromBeginning);

    if Assigned(WebBrowser1.Document) then begin
      //TWebBrowserに表示(IEオブジェクトに表示)
      PersStream := WebBrowser1.Document as IPersistStreamInit;
      PersStream.Load(TStreamAdapter.Create(AStream));
    end;
  finally
    SL.Free;
    AStream.Free;
  end;
end;

end.




04_HTML コードや選択中のテキストの取得


TWebBrowser で表示している HTML コードまたはテキストのみを取得する例です.
Document を IHTMLDocument2 でキャストして取得します.


図8
設計時画面
図9
Button1 クリック
図10
Button2 クリック
図11
[OK] をクリック

リスト3
HTML コードやテキスト部分の取得
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses  MSHTML, ActiveX;

{$R *.dfm}

//=============================================================================
//  指定のURLを表示(ここではローカルなHTMLファイル)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AURL : String;
begin
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  WebBrowser1.Navigate(AURL);
end;

//=============================================================================
//  HTMLコードを取得して表示
//  TWebBrowseのアプリケーションはInternetExplorerであるが,TWebBrowserでは
//  TWebBrowser.DocumentをIHTMLDocument2でキャストしてして取得できる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEElement : IHTMLElement;
begin
  if Assigned(WebBrowser1.Document) then begin
    IEElement := (WebBrowser1.Document as IHTMLDocument2).body.parentElement;
    ShowMessage(IEElement.outerHTML);

    //ついでにのテキスト部分のみを取得して表示
    //このコードはタグ内の文字を取得するのではなく,表示テキストを取得する
    //<>や半角空白等の特殊文字も正確に取得する
    IEElement := (WebBrowser1.Document as IHTMLDocument2).body;
    ShowMessage(IEElement.outerText);
  end;
end;

//=============================================================================
//  HTMLコードを取得して表示
//  TWebBrowseのアプリケーションはInternetExplorer
//  IEObj(IEオブジェクト)のDocumentをIHTMLDocument2でキャストして取得する
//  IEObj(InternetExplorer)にキャストしても,WebBrowser1のまま使用しても同じ
//
//  結果はButton2Clickと同じ
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  IEObj     : InternetExplorer;
  IEElement : IHTMLElement;
begin
  IEObj := WebBrowser1.Application as InternetExplorer;

  if Assigned(IEObj) then begin
    if Assigned(IEObj.Document) then begin
      IEElement := (IEObj.Document as IHTMLDocument2).body.parentElement;
      ShowMessage(IEElement.outerHTML);

      //ついでにのテキスト部分のみを取得して表示
      //このコードはタグ内の文字を取得するのではなく,表示テキストを取得する
      //<>や半角空白等の特殊文字も正確に取得する
      IEElement := (IEObj.Document as IHTMLDocument2).body;
      ShowMessage(IEElement.outerText);
    end;
  end;
end;

end.


選択中のテキストのみの取得であれば,ExecWB メソッド等を使用して取得可能です.
ExecWB メソッドには引数が 4 つありますが,実際には最初の 2 つか使用されていないようです.この他,印刷,印刷プレビュー等のコマンドもこの ExecWB メソッドで実行できます.
OLECMDID 列挙体は,このメソッドの第 1 引数,OLECMDEXECOPT 列挙体が第 2 引数です.これらの列挙体のメンバーの中のいずれか 1 つを指定します.


選択中のテキストだけの取得と,選択の解除
//=============================================================================
//  選択中のテキストを取得
//  クリップボードを使用
//  選択中のテキストがない場合は,現在,クリップボードにあるテキストの取得となる
//  usesにClipbrdが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  varIn  : OleVariant;
  varOut : OleVariant;
begin
  if Assigned(WebBrowser1.Document) then begin
    //コピー
    varIn  := null;
    varOut := null;
    WebBrowser1.ExecWB(OLECMDID_COPY,
                       OLECMDEXECOPT_DONTPROMPTUSER,
                       varIn,
                       varOut);
    //クリップボードから取得
    ShowMessage(Clipboard.AsText);
  end;
end;

//=============================================================================
//  選択中のテキストを取得
//  IHTMLTxtRangeを使用
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  iDoc2   : IHTMLDocument2;
  StrText : String;
begin
  iDoc2 := WebBrowser1.Document as IHTMLDocument2;

  if iDoc2 <> nil then begin
    StrText := (iDoc2.selection.createRange as IHTMLTxtRange).Text;
    MessageBox(Handle, PChar(StrText), '選択テキスト', MB_OK);
 end;
end;

//=============================================================================
//  選択状態を解除
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  IESelObj : IHTMLSelectionObject;
begin
  if Assigned(WebBrowser1.Document) then begin
    IESelObj := (WebBrowser1.Document as IHTMLDocument2).selection;
    IESelObj.clear;
  end;
end;




05_TWebBrowser の実行時 ( 動的 ) 生成


TWebBrowser コンポーネントが HTML ファイルそのものを表示しているわけではありません.表示用のコンテナです.したがって,Parent プロパティの設定に注意が必要です.
TWebBrowser は IE オブジェクトを生成して HTML ファイル等を表示しますが,TWebBrowser のオブジェクトそのものは IE オブジェクトとして扱えるようになっています.


図12
設計時画面
図13
Button1クリック
  • TWebBrowser が生成され,HTML ファイルを表示

リスト4
実行時 (動的) に TWebBrowser コンポーネントを生成
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  TWebBrowserを実行時(動的)に生成
//  ビジュアルなコントロール(コンポーネント)にはParentプロパティの設定が必要
//  これがないとどこに表示していいか不明となってしまう
//  TWebBrosserは直接Parentを指定できないので,TOleControlにキャストする
//
//  TWebBrowserの使用にはusesにSHDocVwが必要
//  TOleControlの使用にはusesにOleCtrlsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  WebBrowser : TWebBrowser;
  AURL       : String;
begin
  //TWebBrowserを生成
  WebBrowser := TWebBrowser.Create(Self);

  //Parentを設定
  //TEmbeddedWBであればWebBrowser.Parent := Self;でOK
  TOleControl(WebBrowser).Parent := Self;
  //Alignを設定
  WebBrowser.Align := alClient;

  //サイトのページ(ここではローカルなHTMLファイル)を表示
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  WebBrowser.Navigate(AURL);
end;

end.


TEmbeddetWB コンポーネントは,Parent プロパティを直接指定できます.


リスト5
TEmbeddedWBコンポーネントを実行時に生成

procedure TForm1.Button1Click(Sender: TObject);
var
  WebBrowser : TEmbeddedWB;
  AURL       : String;
begin
  //TEmbeddedWBを生成
  WebBrowser := TEmbeddedWB.Create(Self);

  //Parentを設定
  WebBrowser.Parent := Self;
  //Alignを設定
  WebBrowser.Align := alClient;

  //サイトのページ(ここではローカルなHTMLファイル)を表示
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  WebBrowser.Navigate(AURL);
end;




06_TOleContainer で表示


TOleContainer コンポーネントは,いろいろなオブジェクトを表示できるコンテナコンポーネントです.ここに HTML を表示するテストです.


図14
設計時画面
  • TOleContainer を配置
図15
Button1 クリック
  • ローカルな HTML を表示
図16
Button2 クリック
  • Web サイトのページを表示

リスト6
TOleContainer コンポーネントに HTML を表示
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  このフォームにはTOleContainerを配置してある
//  ここにIE(InternetExploorer)オブジェクトを生成し表示
//  OleObject.ApplicationをInternetExplorerにキャスト
//
//  Naviageメソッドの第2引数は以下の組み合わせ
//  これらの定数はSHDocVw.pas内にあるが,TEmbeddedWBコンポをインストールすると
//  IEConst.pas内に定数値のリストがある
//
//  navOpenInNewWindow = $01; 新しいウィンドウを開いて表示
//  navNoHistory       = $02; 履歴に追加しない
//  navNoReadFromCache = $04; ページ表示にディスクキャッシュを使用しない
//  navNoWriteToCache  = $08; 表示ページをディスクキャッシュに書込まない
//  navAllowAutosearch = $10; 失敗したらルートドメイン等を検索して表示
//
//  InternetExplorerの使用にはusesにShDocVwが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  IEObj : InternetExplorer;
  AURL  : String;
  Flag  : OleVariant;
begin
  //IEオブジェクトを生成
  //CreateOleObject('InternetExplorer.Application');ではないので注意
  OleContainer1.CreateObject('Shell.Explorer', False) ;

  //それを起動して表示
  OleContainer1.DoVerb(ovPrimary);

  //IEオブジェクトを取得しておく
  IEObj := IDisPatch(OleContainer1.OleObject.Application) as InternetExplorer;

  //指定のURLを表示(ここではローカルなHTMLファイル)
  //引数は省略できない
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  Flag := navNoHistory or navNoReadFromCache or navNoWriteToCache;
  IEObj.Navigate(AURL,         //表示するURL
                 Flag,         //各種設定フラグ
                 EmptyParam,   //表示フレームの指定
                 EmptyParam,   //サーバに送信するデータ
                 EmptyParam);  //サーバに送信するHTTPヘッダ

  //読み込み完了まで待つ
  while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //サイトページのTitleを表示
  //ローカルのHTMLの場合にはLocationNameはファイル名となる
  Self.Caption := IEObj.LocationName;
end;

//=============================================================================
//  このフォームにはTOleContainerを配置してある
//  ここにIE(InternetExploorer)オブジェクトを生成し表示
//
//  IEをOleVariant型で操作する場合のコード例
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEObj : OleVariant;
  AURL  : String;
begin
  //IEオブジェクトを生成
  //CreateOleObject('InternetExplorer.Application');ではないので注意
  OleContainer1.CreateObject('Shell.Explorer', False) ;

  //それを起動して表示
  OleContainer1.DoVerb(ovPrimary);

  //IEオブジェクトを取得しておく
  IEObj := OleContainer1.OleObject;

  //指定のURLを表示(ここではローカルなHTMLファイル)
  AURL := '';
  IEObj.Navigate('http://mrxray.on.coocan.jp/index.htm');

  //読み込み完了まで待つ
  while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //サイトページのTitleを表示
  Self.Caption := IEObj.LocationName;
end;

end.




07_IE の新規起動 - CreateComObject を使用


IE オブジェクトとして TWebBrowser を使用する方法は,アプリケーションのフォームに配置して利用できるので,他の操作用のコントロールも配置しての操作に便利ですが,このサンプルコードは,IE を単独で起動します.いずれにしても操作対象そのものは IE オブジェクトとなるので操作用のコードに大きな違いはありません.

以下は IE のオブジェクトを CreateComObject で生成する例です.
このサンプルは,管理者権限 (管理者として実行) で実行しないと正常に動作しません.


図17
設計時画面
  • 管理者権限で実行する
図18
Button1 クリック
  • ブラウザ (IE) が起動しHTMLが表示される
  • ここではローカルな HTM ファイル
  • ツールバー等を非表示で起動している
図19
Button2 クリック
  • 表示中の HTML コードを取得してダイアログで表示
図20
Button3 クリック
  • 起動したブラウザ (IE) が閉じる

リスト7
ブラウザ (IE) を起動,終了させる
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses ComObj, MSHTML;

{$R *.dfm}

//=============================================================================
//  IEを新規起動 CreateComObjectを使用
//
//  Naviageメソッドの第2引数は以下の組み合わせ
//  navOpenInNewWindow = $01; 新しいウィンドウを開いて表示
//  navNoHistory       = $02; 履歴に追加しない
//  navNoReadFromCache = $04; ページ表示にディスクキャッシュを使用しない
//  navNoWriteToCache  = $08; 表示ページをディスクキャッシュに書込まない
//  navAllowAutosearch = $10; 失敗したらルートドメイン等を検索して表示
//
//  CreateComObjectはusesにComObjが必要
//  定数値READYSTATE_INTERACTIVEの使用にはusesにSHDocVwが必要
//
//  IEObj.ReadyStateとハンドル取得には管理者権限での実行が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Flag : OleVariant;
  AURL : String;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then exit;

  //InternetExplorerオブジェクトを新規生成
  //InternetExplorerにキャストするとコード補完機能が使用可能
  //ただしNavigate等のメソッド類の引数は省略できない
  //キャストしない場合はIEObjをOleVariantとして扱う
  // Result := CreateComObject(CLASS_InternetExplorer) as IWebBrowser2;
  IEObj := CreateComObject(CLASS_InternetExplorer) as InternetExplorer;

  //表示フラグの設定
  //このサンプルでは,すでにIEを新規起動しているのでタブ関係フラグは無効
  Flag := navNoHistory or navNoReadFromCache or navNoWriteToCache;

  //指定のURLを表示(ここではローカルなHTMLファイル)
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  IEObj.Navigate(AURL, Flag, EmptyParam, EmptyParam, EmptyParam);

  //読み込み完了まで待つ
  while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  IEObj.Visible := True;

  //IEオブジェクトの操作例
  //位置とサイズ等を設定
  //既定のサイズで表示されてからの設定なので少しちらつく
  IEObj.Top     := 0;
  IEObj.Left    := 0;
  IEObj.Width   := 500;
  IEObj.Height  := 400;
  IEObj.ToolBar := 0;
  IEObj.MenuBar := False;

  //後の操作用にハンドルを取得しておく
  //ローカルのHTMLの場合にはLocationNameはファイル名となる
  IEHandle := IEObj.HWnd;
  Self.Caption := IntToStr(IEHandle) + '  ' + IEObj.LocationName;
end;

//=============================================================================
//  IEオブジェクトではなく,IEドキュメントの操作例
//  HTMLの全ソースを取得して表示
//  usesにMSHTMLが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEElement : IHTMLElement;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    if Assigned(IEObj.Document) then begin
      IEElement := (IEObj.Document as IHTMLDocument2).body;

      while IEElement.parentElement <> nil do begin
        IEElement := IEElement.parentElement;
      end;
      ShowMessage(IEElement.outerHTML);
    end;
  end else begin
    ShowMessage('表示したブラウザは既に閉じています. ');
    if Assigned(IEObj) then IEObj := nil;
    IEHandle := 0;
  end;
end;

//=============================================================================
//  IEオブジェクトを閉じて切断
//  QuitとUnassignedを使用
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    IEObj.Quit;
  end else begin
    ShowMessage('表示したブラウザは既に閉じています. ');
  end;

  if Assigned(IEObj) then IEObj := nil;
  IEHandle := 0;
end;

end.




08_IE の新規起動 - CreateOleObject を使用


これも IE を単独で起動します.いずれにしても操作対象そのものは IE オブジェクトとなるので操作用のコードに大きな違いはありません.

以下は IE のオブジェクトをCreateOLEObject で生成して InternetExplorer オブジェクトにキャストしています.キャストとして使用する方法は,メソッド類の引数が省略できない等の不便な点もありますが,設計時にコード補完機能が使用できて便利なこともあります.

このサンプルは,管理者権限 (管理者として実行) で実行しないと正常に動作しません.


図21
設計時画面
  • 管理者権限で実行する
図22
Button1 クリック
  • ブラウザ (IE) が起動し HTML が表示される
  • ここではローカルな HTM ファイル
  • ツールバー等を非表示で起動している
図23
Button2 クリック
  • 表示中の HTML コードを取得して表示
図24
Button3 クリック
  • 起動したブラウザ (IE) が閉じる

リスト8
ブラウザ (IE) を起動,終了させる.CreateOleObject を使用
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses ComObj, MSHTML;

{$R *.dfm}

//=============================================================================
//  IEを新規起動 CreateOleObjectを使用
//
//  Naviageメソッドの第2引数は以下の組み合わせ
//  navOpenInNewWindow = $01; 新しいウィンドウを開いて表示
//  navNoHistory       = $02; 履歴に追加しない
//  navNoReadFromCache = $04; ページ表示にディスクキャッシュを使用しない
//  navNoWriteToCache  = $08; 表示ページをディスクキャッシュに書込まない
//  navAllowAutosearch = $10; 失敗したらルートドメイン等を検索して表示
//
//  CreateComObjectはusesにComObjが必要
//  定数値READYSTATE_INTERACTIVEの使用にはusesにSHDocVwが必要
//
//  IEObj.ReadyStateとハンドル取得には管理者権限での実行が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Flag : OleVariant;
  AURL : String;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then exit;

  //InternetExplorerオブジェクトを新規生成
  //InternetExplorerにキャストするとコード補完機能が使用可能
  //ただしNavigate等のメソッド類の引数は省略できない
  //キャストしない場合はIEObjをOleVariantとして扱う
  IEObj := CreateOleObject('InternetExplorer.Application') as InternetExplorer;

  //表示フラグの設定
  Flag := navNoHistory or navNoReadFromCache or navNoWriteToCache;

  //指定のURLを表示(ここではローカルなHTMLファイル)
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  IEObj.Navigate(AURL, Flag, EmptyParam, EmptyParam, EmptyParam);

  //読み込み完了まで待つ
  while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //IEオブジェクトの操作例
  //位置とサイズ等を設定
  IEObj.Top        := 0;
  IEObj.Left       := 0;
  IEObj.Width      := 500;
  IEObj.Height     := 400;
  IEObj.ToolBar    := 0;
  IEObj.MenuBar    := False;
  IEObj.AddressBar := False;

  //前のサンプルではVistible := TrueにしてからIEオブジェクトを操作したが,
  //このサンプルでは,IEオブジェクトの設定後にVisibleにしてみる
  IEObj.Visible := True;

  //後の操作用にハンドルを取得しておく
  //ローカルのHTMLの場合にはLocationNameはファイル名となる
  IEHandle     := IEObj.HWnd;
  Self.Caption := IntToStr(IEHandle) + '  ' + IEObj.LocationName;
end;

//=============================================================================
//  IEドキュメントの操作例
//  HTMLの全ソースを取得して表示
//  usesにMSHTMLが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEElement : IHTMLElement;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    if Assigned(IEObj.Document) then begin
      IEElement := (IEObj.Document as IHTMLDocument2).body;
      ShowMessage(IEElement.parentElement.outerHTML);
    end;
  end else begin
    ShowMessage('表示したブラウザは既に閉じています. ');
    IEObj    := nil;
    IEHandle := 0;
  end;
end;

//=============================================================================
//  IEオブジェクトを閉じて切断
//  QuitとUnassignedを使用
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    IEObj.Quit;
  end else begin
    ShowMessage('表示したブラウザは既に閉じています. ');
  end;

  IEObj    := nil;
  IEHandle := 0;
end;

end.




09_IE の新規起動 - CreateOleObject を OleVariantで扱う


これも,IE を単独で起動します.いずれにしても操作対象そのものは IE オブジェクトとなるので操作用のコードに大きな違いはありません.

このサンプルでは,CreateOLEObject で生成して,OleVariant 型で扱うものです.OleVariant 型で扱うと型キャストをする必要がなく便利である一方,実際にコンパイルして実行してみないと検出できないことがあります.

このサンプルは,管理者権限 (管理者として実行) で実行しないと正常に動作しません.


リスト9
ブラウザ (IE) を起動,終了させる.CreateOleObject で生成して OleVariant で扱う
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses ComObj, SHDocVw, MSHTML;

{$R *.dfm}

//=============================================================================
//  IEを新規起動 CreateOleObjectを使用
//
//  Naviageメソッドの第2引数は以下の組み合わせ
//  navOpenInNewWindow = $01; 新しいウィンドウを開いて表示
//  navNoHistory       = $02; 履歴に追加しない
//  navNoReadFromCache = $04; ページ表示にディスクキャッシュを使用しない
//  navNoWriteToCache  = $08; 表示ページをディスクキャッシュに書込まない
//  navAllowAutosearch = $10; 失敗したらルートドメイン等を検索して表示
//
//  CreateComObjectはusesにComObjが必要
//  定数値READYSTATE_INTERACTIVEの使用にはusesにSHDocVwが必要
//
//  IEObj.ReadyStateとハンドル取得には管理者権限での実行が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Flag : OleVariant;
  AURL : String;
begin
  if not VarIsEmpty(IEObj) and (GetWindow(IEHandle, 0) > 0) then exit;

  //InternetExplorerオブジェクトを新規生成
  //InternetExplorerにキャストするとコード補完機能が使用可能
  //ただしNavigate等のメソッド類の引数は省略できない
  //キャストしない場合はIEObjをOleVariantとして扱う
  IEObj := CreateOleObject('InternetExplorer.Application');

  //表示フラグの設定
  Flag := navNoHistory or navNoReadFromCache or navNoWriteToCache;

  //指定のURLを表示(ここではローカルなHTMLファイル)
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  IEObj.Navigate(AURL, Flag);

  //読み込み完了まで待つ
  while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //IEオブジェクトの操作例
  //位置とサイズ等を設定
  IEObj.Top     := 0;
  IEObj.Left    := 0;
  IEObj.Width   := 500;
  IEObj.Height  := 400;
  IEObj.ToolBar := 0;
  IEObj.MenuBar := False;

  //前のサンプルではVistible := TrueにしてからIEオブジェクトを操作したが,
  //このサンプルでは,IEオブジェクトの設定後にVisibleにしてみる
  IEObj.Visible := True;

  //後の操作用にハンドルを取得しておく
  //ローカルのHTMLの場合にはLocationNameはファイル名となる
  IEHandle     := IEObj.HWnd;
  Self.Caption := IntToStr(IEHandle) + '  ' + IEObj.LocationName;
end;

//=============================================================================
//  IEドキュメントの操作例
//  HTMLのソースを取得して表示
//  usesにMSHTMLが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEElement : OleVariant;
begin
  if not VarIsEmpty(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    if not VarIsEmpty(IEObj.Document) then begin
      IEElement := IEObj.Document.body;
      ShowMessage(IEElement.parentElement.outerHTML);
    end;
  end else begin
    ShowMessage('表示したブラウザは既に閉じています. ');
    IEObj    := Unassigned;
    IEHandle := 0;
  end;
end;

//=============================================================================
//  IEオブジェクトを閉じて切断
//  エクセルのオブジェクトの使用方法と同様にQuitとUnassigned
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if not VarIsEmpty(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    IEObj.Quit;
  end else begin
    ShowMessage('表示したブラウザは既に閉じています. ');
  end;

  IEObj    := Unassigned;
  IEHandle := 0;

end;

end.




10_ブラウザの新規起動 - ShellExcuteEx を使用


ShellExecuteEx 関数でブラウザを起動する例です.[266_位置とサイズ指定でアプリ起動]のサンプルを参考にすれば,位置とサイズを指定しての表示も可能です.また,他のサンプルコードのように,IE オブジェクトを取得し,それを操作することでも可能です.
ShellExecuteEx では,IE だけではなくデフォルトのブラウザを起動することができます.
通常使用するブラウザを新規に起動あるいは,起動中のブラウザで,ウェブページを表示するだけであれば次のコードのように,ShellExecutet 関数でも十分ですが,ShellExecuteEx 関数を使用すると,起動完了を待つことができます.


//=============================================================================
//  ShellExcuteの使用にはusesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  URL = 'http://www.embarcadero.com/jp';
begin
  ShellExecute(Handle, 'open', URL, nil, nil, SW_SHOWNORMAL);
end;


図25
設計時画面
  • ブラウザが起動中の場合は,起動中のブラウザにページが表示されることもある
  • どのようになるかは,そのブラウザの設定による

リスト10
ShellExecuteEx 関数でブラウザを起動
起動完了を待つ必要がなければ ShellExecute 関数でよい
unit Unit1;

interface

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

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 ShellAPI;

{$R *.dfm}

//=============================================================================
//  ShellExecuteExでファイル表示
//  ファイルを表示したアプリの起動終了を待つ
//  待つ必要がなければ,ShellExecuteで十分
//
//  Windows Vistaではファイルを開く際に管理者権限が必要なことがある.起動時に
//  [ユーザアカウント制御]ダイアログを表示するためにはマニフェストファイルを
//  組み込む必要がある(マニフェストを有効にするためには[ランタイムテーマを有
//  効にする]のチェックを外す必要あり)
//
//  起動したアプリのハンドルを取得するコードについては以下を参照
//  [266_位置とサイズ指定でアプリ起動]
//
//  SEE_MASK_NOCLOSEPROCESS
//    ShellExcuteEx実行後,プロセスを維持
//    Processメンバにプロセスのハンドルが返る
//  SEE_MASK_FLAG_NO_UI
//    エラー発生時にメッセージを表示しない
//
//  ShellExcuteExの使用にはusesにShellAPIが必要
//=============================================================================
function RunExeFile(hWnd: HWND; AFile: String; AParameters: String;
   Verb: String): Cardinal;
var
  AInfo : TShellExecuteInfo;
  ret   : DWORD;
begin
  FillChar(AInfo, SizeOf(AInfo), 0);
  AInfo.cbSize := SizeOf(AInfo);
  AInfo.Wnd    := hWnd;
  AInfo.fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  AInfo.lpVerb := PChar(Verb);

  AInfo.lpFile       := PChar(AFile);
  AInfo.lpParameters := PChar(AParameters);
  AInfo.nShow        := SW_SHOW;

  ShellExecuteEx(@AInfo);

  //ShellExecuteExは成功するとhInstAppに33以上の値を返す
  if AInfo.hInstApp >= 33 then
  begin
    repeat
      ret := WaitForInputIdle(AInfo.hProcess, 50);
      Application.ProcessMessages;
    until ret <> WAIT_TIMEOUT;
 end;
 Result := AInfo.hInstApp;
end;

//=============================================================================
//  IEを新規起動する
//  ShellExcuteExはTShellExecuteInfo構造体のlpFileのファイル(拡張子)の関連付け
//  でファイルを表示するのであるが,EXEの実行も可能
//
//  ここでは表示するファイル名がIEXPLORE.EXEのコマンドラインオプションというこ
//  となる.IEにはこの他にもいくつかのコマンドラインオプションがあり,例えば
//  -k はIEをキオスク(全画面)モードで起動する(終了は[Alt]+[F4])
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AppStr : String;
  AppCmd : String;
begin
  //IEは関連付けのあるアプリなのでフルパスでなくても起動可能
  AppStr := 'IEXPLORE.EXE';
  AppCmd := 'http://mrxray.on.coocan.jp/index.htm';

  RunExeFile(0, AppStr, AppCmd, '');
end;

//=============================================================================
//  通常使用するブラウザでhtml関係ファイルを表示
//  このコードは,htmに関連付けされているブラウザが起動する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  AppStr : String;
  AppCmd : String;
begin
  AppStr := 'http://mrxray.on.coocan.jp/index.htm';
  AppCmd := '';

  RunExeFile(0, AppStr, AppCmd, '');
end;

end.




11_IE の新規起動 - CreateProcess を使用


CreateProcess 関数でブラウザ (IE) を起動する例です.[266_位置とサイズ指定でアプリ起動] のサンプルを参考にすれば,位置とサイズを指定しての表示も可能です.また,他のサンプルコードのように,IE オブジェクトを取得し,それを操作することでも可能です.


図26
設計時画面
  • IE のバージョンと設定によっては表示中の IE にページが表示されることもある

リスト11
CreateProcess 関数でウェブブラウザ (IE) を起動
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses Registry;

{$R *.dfm}

//=============================================================================
//  CreaateProcessで指定アプリを起動
//
//  Windows Vistaでの注意
//  Windows VistaではCreateProcessの実行に管理者権限が必要なことがある.起動時
//  に[ユーザアカウント制御]ダイアログを表示するためにはマニフェストファイル
//  を組み込む必要がある(マニフェストを有効にするためには[ランタイムテーマを
//  有効にする]のチェックを外す必要あり)
//
//  起動したアプリのハンドルを取得するコードについては以下を参照
//  [266_位置とサイズ指定でアプリ起動]
//=============================================================================
function ExecuteApp(ExeAppStr: String): DWORD;
var
  SI  : TStartupInfo;
  PI  : TProcessInformation;
  ret : DWORD;
begin
  result := 0;
  FillChar(SI, SizeOf(SI), #0);
  SI.cb          := SizeOf(TStartupInfo);
  SI.dwFlags     := STARTF_USESHOWWINDOW;
  SI.wShowWindow := SW_SHOW;
  SetLength(ExeAppStr, Length(ExeAppStr));

  //参照カウンタ対策
  UniqueString(ExeAppStr);
  if not CreateProcess(nil,
                       PChar(ExeAppStr),
                       nil,
                       nil,
                       False,
                       0,
                       nil,
                       nil,
                       SI,
                       PI) then begin
    Result := WAIT_FAILED;
  end else begin
    repeat
      ret := WaitForInputIdle(PI.hProcess,50);
      Application.ProcessMessages;
    until ret <> WAIT_TIMEOUT;

    CloseHandle(PI.hThread);
    CloseHandle(PI.hProcess);
  end;
end;
//=============================================================================
//  IEを新規に起動する
//  CreateProcessは実行可能なファイルを引数に与える
//  CreateProcessでは起動するファイルのフルパスが必要
//  ここではIEのフルパスを与え,その起動オプションとしてHTMLファイルを指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AppStr : String;
begin
  //IEの起動オプションにHTMLファイルを指定(区切りとして空白が必要)
  AppStr := GetIEFullPath + ' '
            + ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  ExecuteApp(AppStr);
end;

//=============================================================================
//  レジストリからIEのフルパスを取得
//  IEのフルパスは関連付けファイル名あるいはIEXPLORE.EXE等からも取得可能
//  詳細は[480_拡張子関連付けの実行ファイル名]を参照
//
//  TRegistryの使用にはusesにRegistryが必要
//=============================================================================
function TForm1.GetIEFullPath: String;
var
  Reg     : TRegistry;
  AppKey  : String;
  AppItem : String;
begin
  Result := '';

  Reg := TRegistry.Create;
  Reg.Access  := KEY_READ;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  AppKey      := 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\IEXPLORE.EXE';
  //既定値を取得するのでAppItemは空文字とする
  AppItem := '';
  try
    if Reg.OpenKey(AppKey,False) then begin
      try
        Result := Reg.ReadString(AppItem);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;
end;

end.




12_ShellWindows で IE と Explorer を区別  -  EXE 名


TShell コンポーネントは,shdocvw.dll の機能の一部をカプセル化しています.このコンポーネントを使用すると,Integnet Explorer の操作が便利になることがありますが,このオブジェクトは,エクスプローラと IE を区別してくれません.どちらもシェルウィンドウの 1 つとして認識します.

このサンプルは,アプリを起動した実行ファイル名から,IE か単なるエクスプローラであるかを判定するテストです.最初に見つけた IE で表示しているページのタイトルを表示します.IE 7 以降のタブ形式の IE では,最初に表示したタブのページタイトルとなります.


図27
設計時画面
図28
実行時画面
  • 表示中のページのタイトルを表示

リスト12
シェルウィンドウの内,最初に起動した IE で表示しているページのタイトルを取得
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses SHDocVw;

{$R *.dfm}

//=============================================================================
//  起動しているIEを調べる
//  EXE名で判定する方法
//
//  ShellWindowsの使用にはusesにSHDocVwが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ShWindows : ShellWindows;
  IEObj     : InternetExplorer;
  i         : Integer;
  ExeName   : String;
  Flag      : Boolean;
begin
  ShWindows := Shell1.Windows as ShellWindows;

  Flag := False;
  //ShWindowsは起動した順に検出する
  for i := 0 to ShWindows.Count - 1 do begin
    IEObj   := ShWindows.Item(i) as InternetExplorer;
    if IEObj <> nil then begin
      //このExeNameの値はエクスプローラならExplorer.EXE,IEであればiexplore.exe
      ExeName := ExtractFileName(IEObj.FullName);
      if LowerCase(ExeName) = 'iexplore.exe' then begin
        //最初に起動したIEを見つけたら終了
        Flag := True;
        Break;
      end;
    end;
  end;

  if Flag then begin
    //最初に起動したIEを前面に表示
    SetForegroundWindow(IEObj.HWnd);
    //表示されるタイトルは最初に表示したタブ
    MessageBox(Handle, PChar(IEObj.LocationName), 'ページタイトル', MB_OK);
  end else begin
    MessageBox(Handle, 'IE は起動していません.', '確認', MB_OK);
  end;
end;

end.




13_ShellWindowsで IE と Explorer を区別  -  クラス名


このサンプルは,IE のクラス名が IEFrame であることを利用して,IE とエクスプローラを判定するテストです.
最初に見つけた IE で表示しているページのタイトルを表示します.IE 7 以降のタブ形式の IE では,最初に表示したタブのページタイトルとなります.


図29
設計時画面
図30
実行時画面
  • 表示中のページのタイトルを表示

リスト13
シェルウィンドウの内,最初に起動した IE で表示しているページのタイトルを取得
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses SHDocVw;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
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;

//=============================================================================
//  起動しているIEを調べる
//  クラス名で判定する方法
//
//  ShellWindowsの使用にはusesにSHDocVwが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ShWindows : ShellWindows;
  IEObj     : InternetExplorer;
  i         : Integer;
  ClassName : String;
  Flag      : Boolean;
begin
  ShWindows := Shell1.Windows as ShellWindows;

  Flag := False;
  //ShWindowsは起動した順に検出する
  for i := 0 to ShWindows.Count - 1 do begin
    IEObj   := ShWindows.Item(i) as InternetExplorer;
    if IEObj <> nil then begin
      //このClassNameの値は,IEであればIEFrame
      ClassName := GetWindowClassNameStr(IEObj.HWnd);
      if UpperCase(ClassName) = 'IEFRAME' then begin
        //最初に起動したIEを見つけたら終了
        Flag := True;
        Break;
      end;
    end;
  end;

  if Flag then begin
    //最初に起動したIEを前面に表示
    SetForegroundWindow(IEObj.HWnd);
    //表示されるタイトルは最初に表示したタブ
    MessageBox(Handle, PChar(IEObj.LocationName), 'ページタイトル', MB_OK);
  end else begin
    MessageBox(Handle, 'IE は起動していません.', '確認', MB_OK);
  end;
end;

end.




14_起動中の IE に Web ページを表示


起動中の IE にウェブページを表示します.
ここでは最初に起動した IE だけを検出し,新規にタブを作成するか,最初に作成されたタブにウェブページを表示します.タブ形式でない IE では,常に最初に起動した IE に表示します.


図31
設計時画面

リスト14
起動中の IE に Web ページを表示.新規タブまたは既成のタブ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleServer, Shell32_TLB, SHDocVw;

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

var
  Form1: TForm1;

implementation

//uses SHDocVw;

{$R *.dfm}

//  この定数値はSHDocVw.pasにないので追加
const
  navOpenInNewTab = $00000800;

//=============================================================================
//  起動中のIEに新規にタブを作成してWebページを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  IEObj  : InternetExplorer;
  AFlag  : OleVariant;
  URL    : OleVariant;
begin
  IEObj := GetFirstCreateIEObject;
  if IEObj = nil then begin
    MessageBox(Handle, 'IE は起動していません.', '確認', MB_OK);
    exit;
  end;

  URL   := ExtractFilePath(Application.ExeName) + 'Delphi_Oracle.htm';
  AFlag := navOpenInNewTab;
  IEObj.Navigate2(URL, AFlag, EmptyParam, EmptyParam, EmptyParam);

  //IEを前面に表示
  SetForegroundWindow(IEObj.HWnd);
end;

//=============================================================================
//  起動中のIEのタブを作成してWebページを表示
//  表示するタブは,最初に作成されたタブ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEObj : InternetExplorer;
  URL   : OleVariant;
begin
  IEObj := GetFirstCreateIEObject;
  if IEObj = nil then begin
    MessageBox(Handle, 'IE は起動していません.', '確認', MB_OK);
    exit;
  end;

  URL := 'http://mrxray.on.coocan.jp/index.htm';
  //最初に作成されたタブのウィンドウに表示される
  IEObj.Navigate2(URL, 0, EmptyParam, EmptyParam, EmptyParam);

  //IEを前面に表示
  SetForegroundWindow(IEObj.HWnd);
end;

//=============================================================================
//  最初に起動したIEを取得して返す関数
//
//  ShellWindowsの使用にはusesにSHDocVwが必要
//=============================================================================
function TForm1.GetFirstCreateIEObject: InternetExplorer;
var
  ShWindows : ShellWindows;
  IEObj     : InternetExplorer;
  i         : Integer;
  ExeName   : String;
begin
  ShWindows := Shell1.Windows as ShellWindows;

  Result := nil;
  //ShWindowsは起動した順に検出する
  for i := 0 to ShWindows.Count - 1 do begin
    IEObj   := ShWindows.Item(i) as InternetExplorer;
    if IEObj <> nil then begin
      //このExeNameの値はエクスプローラならExplorer.EXE,IEであればiexplore.exe
      ExeName := ExtractFileName(IEObj.FullName);
      if LowerCase(ExeName) = 'iexplore.exe' then begin
        //最初に起動したIEを見つけたら終了
        Result := IEObj;
        Break;
      end;
    end;
  end;
end;

end.




15_IE のタブ情報の取得と操作 - Internet Explorer_Server を検出


IE 7 以降のタブ形式の IE のタブで表示しているウェブページの操作の参考コードです.
このサンプルでは,単に各タブで表示しているウェブページのタイトルを取得して表示,あるいはタブに別のウェブページ表示するだけですが,コード中の TabIE という変数は IWebbrowser2 インターフェイスのオブジェクトです.これを使用して各種の情報を取得したり,操作できます.

このサンプルのコードは,TEmbeddedWB コンポーネントのサイトの Automating IE のページのサンプルを参考にして作成しています.参考サイトでは,
LoadLibrary を使用して DLL 内の関数を使用していますが,oleacc を uses に追加すれば,これらの関数を使用することができます.
サンプルでは,IE のハンドルから,クラス名が Internet Explorer_Server の子ウィンドウを列挙しています.このクラス名のウィンドウが実際にウェブページを表示しているコントロールです.このウィンドウに対して,WM_HTML_GETOBJECT メッセージを送ることにより,各タブのドキュメントのポインタを取得します.
このメッセージの ID はレジストリに格納されています.これを RegisterWindowMessage 関数で取得します.

なお,タブを切り換える関数は用意されていないようです.タブを切換えるには,[Ctrl] + [Tab] 等のキーを送信する方法が考えられます.


図32
IE 8.0 のウィンドウ階層
  • IE 本体のクラス名は IEFrame
  • タブを 2 つ表示しているので,クラス名が
    Internet Explorer_Server
    のウィンドウが 2 つある.このウィンドウが実際の表示コントロール
  • 最後尾に $ 記号がないのがアクティブなタブ
図33
設計時画面
図34
実行時画面
  • 各タブのページタイトルを取得して表示

リスト15
タブ形式 IE のタブ情報の取得と操作.Internet Explorer_Server を検出
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses SHDocVw, oleacc, MSHTML, ActiveX;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
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;

//-----------------------------------------------------------------------------
//  EnumChildWindowsのコールバック関数
//-----------------------------------------------------------------------------
function EnumChildWndProc(hWindow: hWnd; lPar: TList):
  Boolean; Stdcall;
begin
  Result := True;

  //子ウィンドウのタイトルがウェブページを表示しているウィンドウだっら検索終了
  if GetWindowClassNameStr(hWindow) = 'Internet Explorer_Server' then begin
    //そのハンドル値を引数のlParに返す
    lPar.Add(Pointer(hWindow));
  end;
end;

//=============================================================================
//  起動IEのタブに表示している情報を取得
//  ここでは最後にアクティブだったIEが対象
//
//  コード以下のサンプルを参照
//  http://www.bsalsa.com/ie_tools_auto.html
//
//  ShellWindows,IWebbrowserApp,IWebbrowser2の使用にはusesにSHDocVwが必要
//  ObjectFromLresultの使用にはusesにoleaccが必要
//  IHTMLDocument2の使用にはusesにMSHTMLが必要
//  IServiceproviderの使用にはusesにActiveXが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  IEHandle : HWND;
  AList    : TList;
  i        : Integer;
  TabWnd   : HWND;
  AMsg     : Cardinal;
  iRes     : Cardinal;
  pDoc     : IHTMLDocument2;
  TabIE    : IWebbrowser2;
  IService : IServiceProvider;
  URL      : OleVariant;
begin
  //最後にアクティブだったIEを検索
  IEHandle := FindWindow('IEFrame', nil);
  if IEHandle = 0 then begin
    MessageBox(Handle, 'IE は起動していません.', '確認', MB_OK);
    exit;
  end;

  AList := TList.Create;
  try
    //タブのウィンドウハンドルを列挙する
    //アクティブなタブが最初に検索されるようである
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(AList));

    for i := 0 to AList.Count - 1 do begin
      TabWnd := Integer(AList.Items[i]);

      //WM_HTML_GETOBJECTメッセージのIDを取得
      AMsg := RegisterWindowMessage('WM_HTML_GETOBJECT');
      //タブウィンドに対して取得メッセージを送る
      //この戻り値はドキュメントのポインタ
      SendMessageTimeOut(TabWnd, AMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, iRes);

      //IWebbrowser2インターフェイスのオブジェクト(TabIE)を取得
      if ObjectFromLresult(iRes, IHTMLDocument2, 0, pDoc) = S_OK then begin
        IService := pDoc.parentWindow as IServiceprovider;
        IService.QueryService(IWebbrowserApp, IWebbrowser2, TabIE);

        if TabIE <> nil then begin
          //ページのタイトルを表示
          MessageBox(Handle, PChar(TabIE.LocationName), 'ページタイトル', MB_OK);
          //2番目に(2番目のタブとは限らない)検出したタブに指定のURLのページを表示
          if i = 1 then begin
            URL := 'http://www.embarcadero.com/jp/products/delphi';
            TabIE.Navigate2(URL, 0, EmptyParam, EmptyParam, EmptyParam);
          end;
        end;
      end;

    end;
  finally
    FreeAndNil(AList);
  end;
end;

end.




16_IE のタブ情報の取得と操作 - ShellWindows だけを使用


タブの情報は,ShellWindows オブジェクトだけでも取得できます.ただし,次のコードの IEObj で取得するハンドルは,IE そのもののハンドルとなっています.実際にウェブページを表示しているコントロールのウィンドウハンドルは取得できません.

以下のサンプルコードは,最初に起動した IE の,最初に作成されたタブの順に,各タブで表示しているウェブページのタイトルを取得して ListBox1 に表示します.
また,2 番目に検出したタブに指定 URL のページを表示し,指定 URL のページがあれば,そのタブをアクティブにします.タブ形式の IE ではない場合は,サンプルコード内の TabNo 変数をリセットするコードを削除すれば,起動した順番がタブ順と同じとなります.


図35
設計時画面
図36
実行時画面
  • 各タブのページタイトルを取得して表示

リスト16
タブ形式 IE のタブ情報の取得と操作.ShellWindows だけを使用
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses SHDocVw, MSHTML, StrUtils;

{$R *.dfm}

//=============================================================================
//  起動IEのタブに表示している情報を取得
//  ShellWindowsだけを使用
//
//  ShellWindowsの使用にはusesにSHDocVwが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ShWindows : ShellWindows;
  OldIEObj  : InternetExplorer;
  IEObj     : InternetExplorer;
  i         : Integer;
  TabNo     : Integer;
  ExeName   : String;
  URL       : OleVariant;
  ActiveURL : String;
  ActiveTab : Byte;
  KeyFlag   : Cardinal;
begin
  ShWindows := Shell1.Windows as ShellWindows;

  ListBox1.Items.Clear;

  //ShWindowsは起動した順に検出する
  TabNo    := 1;
  OldIEObj := nil;
  for i := 0 to ShWindows.Count - 1 do begin
    IEObj := ShWindows.Item(i) as InternetExplorer;
    if IEObj <> nil then begin
      //このExeNameの値はエクスプローラならExplorer.EXE,IEであればiexplore.exe
      ExeName := ExtractFileName(IEObj.FullName);
      if LowerCase(ExeName) = 'iexplore.exe' then begin

        //複数のIEが起動している場合の対応策
        //異なるIEになったらタブ番号を1にリセット
        //OldIEObjとIEObjの比較ではないことに注意
        if (OldIEObj = nil) or (OldIEObj.HWnd <> IEObj.HWnd) then begin
          OldIEObj := IEObj;
          TabNo    := 1;
        end;
        ListBox1.Items.Add(IEObj.LocationName);

        //起動したIEの2番目に作成されたタブに指定URLのページを表示
        if TabNo = 2 then begin
          URL := 'http://www.embarcadero.com/jp/products/delphi';
          IEObj.Navigate2(URL, 0, EmptyParam, EmptyParam, EmptyParam);
        end;

        //このタブがActiveURLのページであったらアクティブにする
        ActiveURL := 'http://mrxray.on.coocan.jp/';
        if StrUtils.ContainsText(IEObj.LocationURL, ActiveURL) then begin
          SetForegroundWindow(IEObj.HWnd);
          ActiveTab := Ord('0') + TabNo;
          KeyFlag   := KEYEVENTF_KEYUP;

          keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
          keybd_event(ActiveTab,  MapVirtualKey(Activetab, 0), 0, 0);
          keybd_event(ActiveTab,  MapVirtualKey(Activetab, 0),  KeyFlag, 0);
          keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KeyFlag, 0);
          //タブの切換えには少しタイムラグが必要
          Sleep(100);
        end;
        TabNo := TabNo + 1;
      end;
    end;
  end;
end;

end.




17_IE のアクティブなタブの情報を取得


現在アクティブなタブの情報を取得と.タブ切換えのサンプルです.
[14_IE のタブ情報の取得と操作 - Internet Explorer_Server を検出] サンプルコードを関数にして利用するようにしてみました.EnumChildWindows が,アクティブなタブのウィンドウを最初に検出することを利用しています.
タブ形式の IE ではない場合は,現在アクティブな IE で表示しているページの情報となりますが,タブの切換えのテストコードは当然ながら機能しません.

IE のタブを切り換える API はないようです.
そこで,このサンプルでは,IE をアクティブにして,keybd_event 関数でキー操作を行っています.
SendMessage や PostMessage でキーコードを送信しても切り換えることはできませんでした.


図37
設計時画面
図38
実行例
  • アクティブなタブのタイトルと URL を取得

リスト17
IE のアクティブなタブの情報取得とタブの切換え
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses SHDocVw, MSHTML, ActiveX, oleacc;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  IE(Internet Explorer)のハンドルから現在アクティブなタブの情報を取得
//  IEHandle  対象のIEのハンドル
//  IE        アクティブなタブのIWebbrowser2インターフェイスのインスタンス
//
//  IHTMLDocument2等の使用にはusesにMSHTMLが必要
//  IServiceproviderの使用にはusesにActiveXが必要
//  ObjectFromLresultの使用にはusesにoleaccが必要
//-----------------------------------------------------------------------------
function GetActiveTabIEInfo(IEHandle: HWND; var IE: IWebbrowser2): Boolean;

  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;

  function EnumChildWndProc(hWindow: hWnd; lPar: PNativeInt):
    BOOL; Stdcall;
  begin
    Result := True;
    if GetWindowClassNameStr(hWindow) = 'Internet Explorer_Server' then begin
      lPar^  := hWindow;
      Result := False;
    end;
  end;

var
  TabWnd   : HWND;
  AMsg     : Cardinal;
  iRes     : Cardinal;
  pDoc     : IHTMLDocument2;
  IService : IServiceProvider;
begin
  Result := False;

  TabWnd := 0;
  EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@TabWnd));
  if TabWnd <> 0 then begin
    AMsg := RegisterWindowMessage('WM_HTML_GETOBJECT');
    SendMessageTimeOut(TabWnd, AMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, iRes);
    if ObjectFromLresult(iRes, IHTMLDocument2, 0, pDoc) = S_OK then begin
      IService := pDoc.parentWindow as IServiceprovider;
      IService.QueryService(IWebbrowserApp, IWebbrowser2, IE);
      if IE <> nil then Result := True;
    end;
  end;
end;

//=============================================================================
//  作成したGetActiveTabIEInfo関数の使用例
//  現在アクティブなタブの情報を取得して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  IEHandle : HWND;
  TabIE    : IWebBrowser2;
begin
  ListBox1.Items.Clear;

  //最初に見つかったIEのハンドルを取得
  IEHandle := FindWindow('IEFrame', nil);
  if IEHandle = 0 then begin
    MessageBox(Handle, 'IE は起動していません.', '確認', MB_OK);
    exit;
  end;

  //そのアクティブタブの情報を取得
  if GetActiveTabIEInfo(IEHandle, TabIE) then begin
    ListBox1.Items.Add(TabIE.LocationName);
    ListBox1.Items.Add(TabIE.LocationURL);
  end;
end;

//=============================================================================
//  作成したGetActiveTabIEInfo関数の使用例
//  タブを切り替えてそのタブの情報を取得して表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEHandle : HWND;
  TabIE    : IWebBrowser2;
  KeyFlag  : Cardinal;
begin
  ListBox1.Items.Clear;

  //最初に見つかったIEのハンドルを取得
  IEHandle := FindWindow('IEFrame', nil);
  if IEHandle = 0 then begin
    MessageBox(Handle, 'IE は起動していません.', '確認', MB_OK);
    exit;
  end;

  //表示タブを切り換える
  //KEYEVENTF_KEYUPを必ず実行する
  SetForegroundWindow(IEHandle);
  KeyFlag := KEYEVENTF_KEYUP;

  keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
  keybd_event(VK_TAB,     MapVirtualKey(VK_TAB, 0),     0, 0);
  keybd_event(VK_TAB,     MapVirtualKey(VK_TAB, 0),     KeyFlag, 0);
  keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KeyFlag, 0);

  //タブの切換えに少しタイムラグ(時間)が必要
  //タブが複数であれば前のTabIEを記憶しておいて比較するとよい
  Sleep(100);

  //切り換わったタブの情報を取得
  if GetActiveTabIEInfo(IEHandle, TabIE) then begin
    ListBox1.Items.Add(TabIE.LocationName);
    ListBox1.Items.Add(TabIE.LocationURL);
  end;
end;

end.




18_IE のバージョン取得


IE のバージョンが必要な時のサンプルです.
IE のバージョン情報は,レジストの以下の場所にあります.IE 9 以前では,このキーの Version 項目名の値,IE 10 以降は svcVersion 項目名の値となっています.これを取得して表示します.
実用的なバージョンの値を取得するには, svcVersion 項目名があればその値,なければ Version 項目名の値を採用することになると思われます.

実行したダイアログの表示は [Ctrl] + [C] でコピーできます.コピーした文字列のバージョン文字列だけを利用できます.


HKEY_LOCAL_MACHINE\Software\Microsoft\Internet Explorer

IE のオブジェクトを操作するアプリケーションの開発者は,IE のバージョンの違いに注意する必要がありそうです.従来の API にも変更があるようです.



図39
Button1 をクリック
  • IE 11 であるが,何故 9.11 と 11.0 という値となっているかは,参考リンクのマイクロソフトの記事を参照
図40
Button2 をクリック
  • 実際に必要なバージョンの値だけを取得

リスト18
ウェブブラウザ (IE) のバージョン番号を取得
IE 9 以前と IE 10 以降で項目名が違うので注意
unit Unit1;

interface

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

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 Registry;

{$R *.dfm}

//=============================================================================
//  インストールされているIEのバージョン文字列を取得
//  ComCtrlsにGetComCtlVersionという関数があるが,IE3~IE6までしか検出できない
//  レジストリから読み出すのが確実
//
//  TRegistryの使用にはusesにRegistryが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LReg       : TRegistry;
  LAppKey    : String;
  LAppItem9  : String;
  LAppItem10 : String;
  LVerStr9   : String;
  LVerStr10  : String;
  LText      : String;
begin
  LReg := TRegistry.Create;
  LReg.Access  := KEY_READ;
  LReg.RootKey := HKEY_LOCAL_MACHINE;
  LAppKey      := 'Software\Microsoft\Internet Explorer';
  LAppItem9    := 'Version';
  LAppItem10   := 'svcVersion';

  try
    if LReg.OpenKey(LAppKey, False) then begin
      try
        LVerStr9  := LReg.ReadString(LAppItem9);
        LVerStr10 := LReg.ReadString(LAppItem10);
        if Trim(LVerStr10) <> '' then begin
        end else begin
        end;
        LText     := LVerStr9 + sLineBreak + LVerStr10;
        MessageBox(Handle, PChar(LText), 'バージョン', MB_OK);
      finally
        LReg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(LReg);
  end;
end;

//=============================================================================
//  インストールされているIEのバージョン文字列を取得
//  ComCtrlsにGetComCtlVersionという関数があるが,IE3~IE6までしか検出できない
//  レジストリから読み出すのが確実
//  svcVersionの値が存在する場合は,その値を,ない場合はVersionの値を取得する例
//
//  TRegistryの使用にはusesにRegistryが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LReg       : TRegistry;
  LAppKey    : String;
  LAppItem9  : String;
  LAppItem10 : String;
  LVerStr9   : String;
  LVerStr10  : String;
  LResult    : Integer;
  LCode      : Integer;
  LText      : String;
begin
  LReg := TRegistry.Create;
  LReg.Access  := KEY_READ;
  LReg.RootKey := HKEY_LOCAL_MACHINE;
  LAppKey      := 'Software\Microsoft\Internet Explorer';
  LAppItem9    := 'Version';
  LAppItem10   := 'svcVersion';

  try
    if LReg.OpenKey(LAppKey, False) then begin
      try
        LVerStr9  := LReg.ReadString(LAppItem9);
        LVerStr10 := LReg.ReadString(LAppItem10);
        if Trim(LVerStr10) <> '' then begin
          LText := LVerStr10;
        end else begin
          LText := LVerStr9;
        end;
        Val(LText, LResult, LCode);
        LText := LText + sLineBreak + IntToStr(LResult);
        MessageBox(Handle, PChar(LText), 'バージョン', MB_OK);
      finally
        LReg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(LReg);
  end;
end;

end.




19_ダイアログ形式でウェブページを表示


ShowHTMLDialog 関数,あるいは ShowHTMLDialogEx 関数を使用すると,ウェブページを,ツールバーもステータスバーもない,ダイアログ形式で表示できます.そのテストです.
TWebBrowser コンポーネントを配置して表示すれば,このような動作をするものが作成できますが,このサンプルは TWebBrowser コンポーネントを使用しません.

これらの関数類は,Delphi XE にはありません.そこでコード内で定義しています.関係する定数も定義しています.ShowHTMLDialog 関数はモーダル表示専用ですが,ShowHTMLDialogEx 関数はモーダル,モードレスのどちらでも表示可能です.どちらも,位置とサイズを指定して,リサイズ不可の設定での表示もできます.指定しなければデフォルトの位置とサイズとなります.
指定可能なオプションは,showModalDialog Method の記事を参考にしてください.


図41
実行時画面
図42
ShowHTMLDialog 関数実行
  • モーダル表示
  • ShowHTMLDialog 関数はモーダル表示専用
図43
ShowHTMLDialogEx 関数実行
  • モードレス表示して,フォーカスが起動したフォームにある状態

リスト19
ダイアログ形式でウェブページを表示する例
unit Unit1;

interface

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

type
  TShowHTMLDialogFN = function(hwndParent: HWND;
                               pMk: IMoniker;
                               pArgIn: POleVariant;
                               pchOptions: PChar;
                               pArgOut: POleVariant): HRESULT; stdcall;

  TShowHTMLDialogExFN = function (hwndParent: HWND;
                               pMk: IMoniker;
                               dwDialogFlags: DWORD;
                               pArgIn: POleVariant;
                               pchOptions: PChar;
                               pArgOut: POleVariant): HRESULT; stdcall;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  //値はMicrosoft SDK 6.0のもの
  HTMLDLG_NOUI           = $0010;
  HTMLDLG_MODAL          = $0020;
  HTMLDLG_MODELESS       = $0040;
  HTMLDLG_PRINT_TEMPLATE = $0080;
  HTMLDLG_VERIFY         = $0100;

//=============================================================================
//  フォーム作成時の処理
//  DLLをロード
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Enabled := False;
  Button2.Enabled := False;

  DllHandle := LoadLibrary('MSHTML.DLL');
  if DllHandle = 0 then exit;

  Button1.Enabled := True;
  Button2.Enabled := True;
end;

//=============================================================================
//  DLLのハンドルを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if DllHandle <> 0 then FreeLibrary(DllHandle);
end;

//=============================================================================
//  ウェブページをダイアログ形式で表示
//  ShowHTMLDialog関数の使用例
//  ShowHTMLDialogはモーダル表示専用
//  サイズや表示位置を指定して表示できる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Dialog      : TShowHTMLDialogFN;
  szURL       : String;
  pURLMoniker : IMoniker;
  pOptions    : String;
begin
  if DllHandle = 0 then exit;
  @Dialog := GetProcAddress(DllHandle, 'ShowHTMLDialog');
  if @Dialog = nil then exit;

  //URLのモニカをpURLMonikerに取得
  szURL := 'http://www.iana.org/domains/example/';
  CreateURLMoniker(nil, PChar(szURL), pURLMoniker);

  //そのモニカを指定してダイアログを表示
  if pURLMoniker <> nil then begin
    pOptions  := 'resizable=yes;dialogHeight:20;';
    Dialog(Handle, pURLMoniker, nil, PChar(pOptions), nil);

    pURLMoniker := nil;
  end;
end;

//=============================================================================
//  ウェブページをダイアログ形式で表示
//  ShowHTMLDialogEx関数の使用例
//  ShowHTMLDialogExはモーダル表示,モードレスで表示どちらでも可能
//  サイズや表示位置の指定,リサイズ不可にしての表示もできる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  DialogEx    : TShowHTMLDialogExFN;
  szURL       : String;
  pURLMoniker : IMoniker;
  dwFlags     : DWORD;
  pOptions    : String;
begin
  if DllHandle = 0 then exit;
  @DialogEx := GetProcAddress(DllHandle, 'ShowHTMLDialogEx');
  if @DialogEx = nil then exit;

  //URLのモニカをpURLMonikerに取得
  szURL := 'http://www.iana.org/domains/example/';
  CreateURLMoniker(nil, PChar(szURL), pURLMoniker);

  //そのモニカを指定してダイアログを表示
  if pURLMoniker <> nil then begin
    dwFlags   := HTMLDLG_MODELESS or HTMLDLG_VERIFY;
    pOptions  := 'resizable=yes;dialogHeight:30;';
    DialogEx(Handle, pURLMoniker, dwFlags, nil, PChar(pOptions), nil);

    pURLMoniker := nil;
  end;
end;

end.




20_Windows API 関数を Delphi の関数に変換


上のサンプルで使用した ShowHTMLDialogEx 関数は,MSDN の記事 (Microsoft SDK でも同じ) では以下のようになっています.これを Delphi の定義に修正した手順を説明しておきます.
これらは C または C++ 言語で書かれています.引数や変数の定義が Delphi とは逆になっています.関数の先頭の HRESULT は関数の戻り値です.Delphi でもそのままです.

リスト20
MSDN の記事の ShowHTMLDialogEx 関数定義
HRESULT ShowHTMLDialogEx(
    HWND hwndParent,
    IMoniker *pMk,
    DWORD dwDialogFlags,
    VARIANT *pvarArgIn,
    LPWSTR pchOptions,
    VARIANT *pvarArgOut
);


リスト21
Delphi の関数に変更した ShowHTMLDialogEx 関数の定義
  TShowHTMLDialogExFN = function (hwndParent: HWND;
                               pMk: IMoniker;
                               dwDialogFlags: DWORD;
                               pArgIn: POleVariant;
                               pchOptions: PChar;
                               pArgOut: POleVariant): HRESULT; stdcall;


LPWSTR は PChar 型ですが,Delphi 2007 以前では PWideChar とします.上のサンプルでは String 型で設定し,関数の引数に渡す際にPCharにキャストしています.

VARIANT 型は,そのままでもコンパイルはできますが,実際に値を渡して実行するとエラーが発生してしまいます.C や C++ の引数,変数はポイント型だからです.
Delphi では,OLE オブジェクトは OleVariant 型で扱います.したがって,OleVariant のポインタ型である POleVariant 型としています.
PChar 型と同じように,コード内での設定は OleVariant 型で設定し,引数に渡す際に POleVariant 型にキャストしています.上のサンプルコードでは,これらの引数は使用していないので,引数で nil としています.この pvarArgIn は,ダイアログを表示する時に,ダイアログに渡すパラメータを指定します.例えばウェブページに入力欄があり,そこに値をセットする場合等に利用できますが,ウェブページの HTML コードに,それらの値を受け取るコードが必要です.

これらのポイント型の引数は,Pointer 型で定義し,引数に渡す時に Pointer でキャストすることもできます.実際,ネット上のサンプルコードでも,そのようなコードを見かけることがあります.
ただし,アドレス指定になっているものは,Addr 関数か,'@' 演算子を使用します.
その他の変数型はそのまま使用しています.


[備考]
C や C++ では,主に変数名に * を付けてポインタ型を定義しますが,Delphi では変数の型でポインタ型を定義します.




21_CoInternetExplorer と CoShellBrowserWindow


これらのオブジェクトは,Create メソッドで生成して使用する場合,全て同じオブジェクトとなります.これらは,SHDovVw.pas 内で InternetExplorer (= IWebBrowser2) にキャストされています.したがって,以下の IEObj は全て同じオブジェクトとなります.


リスト22 
  IEObj := CreateComObject(Class_InternetExplorer) as InternetExplorer;

  IEObj := CreateOleObject('InternetExplorer.Application') as InternetExplorer;

  IEObj := CoInternetExplorer.Create;

  IEObj := CoShellBrowserWindow.Create;   




22_IE コンポーネントのレンダリングの互換モードを確認


下記の参考リンクのマイクロソフトの記事によると,TWebBrowser, TEmbeddedWB 等の IE コンポーネントのレンダリングの互換モードを変更すると,動作が安定する可能性があるようです.その互換モードの確認方法です.
IE コンポーネントは,デフォルトでは,IE 7.0 の互換モードで動作するようになっています.アドレスの入力欄に以下の URL を入力して [Enter] キーを押します.
下図が結果です.筆者の環境では Internet Explorer 7.0 となりました.


http://www.useragentstring.com/



図44
デフォルトでの結果




23_IE コンポーネントのレンダリングの互換モードを変更


互換モードの変更はレジストリを操作します.以下のキーに DWORD の値を追加します.既に追加済の場合は変更となります.名前はアプリの EXE 名にします.下図は plGoogleSearch.exe というプログラムの設定例です.ディレクトリ名は必要ありません.値は,参考リンクのマイクロソフトの記事を参考にしてください.筆者の場合,IE 11 ですので,10 進数で 11000 としています.
Delphi で新規にプロジェクトを作成すると,その EXE 名は Project1.exe ですので,Project1.exe という項目を作成して,その値を 11000 にしておけば便利です.

もし,この FEATURE_BROWSER_EMULATION というキーがない場合は新規に作成します.


HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION


64 ビット版の Windows 7 の場合は,レジストの位置は,以下の場所です.
プログラムを作成してレジストリを操作する場合は,以下のリンクの記事を参考にしてください.

この互換モードを設定しても,そのバージョンの IE と機能や動作が同じになるわけではありません.Windows が提供しているブラウザコントロールは IE 7 仕様です.


HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION


図45

[備考 1]
本項の記事では,レジストリの操作を手作業で行っています.実際に Windows の WebBrowser コントロールを使用するアプリでは,自動で実行するコードを組み込むことになるでしょう.
そのためには,まず,実行環境にインストールされている IE のバージョンを調べ,IE のバージョンに応じた値をレジストリに設定することになります.
Delphi では,TWebBrowser, TEmbeddedWB コンポーネント等が,Windows の WebBrowser コントロールを使用するコンポーネントです.

レジストリの書き込みには管理者権限が必要です.レジストリを操作する部分だけを別の EXE にして,その EXE を管理者権限で実行するか,アプリ全体を管理者権限で実行することになります.
コマンドプロンプトを非表示で起動して,Reg コマンドで操作する方法も考えられます.


[備考 2]
IE のレンダリングの互換モードは,必ずしも最新の IE のバージョンであればいいというわけではありません.IE 6, IE 7 の時代に作成されたウェブページの中には,IE 9 以降では正常に表示されないウェブページもあります.

IE の互換モードは,HTML コードの <head> 部の META タグで,"X-UA-Compatible" 属性値を指定することでも変更できます.IE の互換性の設定は,CSS, JavaScript も影響をうけますから,注意が必要です. [注意]
マイクロソフトの記事にある IE のバージョン判定は,IE 10 以降では無効です.無視されます.


下図が変更した結果です.Internet Explorer 11.0 となっています.



図46
変更後の互換モード




24_IE コンポーネントのレンダリングテスト


ウェブページを作成する側は,現在のバージョンのブラウザで表示,レンダリングの状態を確認するでしょう.しかし,より古いバージョンの IE での確認は省略するかも知れません.確認するには古いバージョンの IE がインストールされた環境が必要です.筆者も行っていません.
したがって,より古いバージョンの IE 互換モードでは正常に表示できないウェブページがある可能性あります.そこで,レンダリングのテストをしてみました.
まず,次のアドレスのページを表示します.

http://acid2.acidtests.org/


図47
レンダリングのテスト
  • The Second Acid Test のページを表示して...
  • Take The Acid2 と reference rending をクリックする

下図が筆者の環境での実行結果です.最初の図は,IE 11.0 互換モードにした場合です.その下の図は互換モードが IE 7.0 の場合で,変更前の結果です.


図48
互換モードが IE 11.0 の場合
  • どちらもスマイリーの画像となる
図49
互換モードが IE 7.0 の場合
  • どちらか,または両方が崩れたスマイリーになってしまう

次は,下の URL で Acid3 のテストを実行した結果です.

http://acid3.acidtests.org/


図50
互換モードが IE 11.0 の場合
  • The Acid3 Test のページを表示するとテスト開始
  • 100 点満点
図51
互換モードが IE 7.0 の場合
  • 不合格