Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年04月17日] [更新 2013年06月28日]　Delphi サンプルプログラム集
945_エクスプローラのテスト
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro + IE 9
[10] Delphi 2010 以降専用
945_ExplorerTest.zip　[5,900 KB]　2013年06月28日版 (EXE 同梱)



  • 2012年07月10日
  • Windows Vista, 7 でも動作可能なコードに修正
  • TWebBrowser にファイルを表示するサンプルを新規ページに移動
  • 2013年06月28日
  • [フォルダーオプション] の設定値取得と設定のサンプルを追加



エクスプローラのテスト


エクスプローラを新規起動したり，表示中のエクスプローラーを操作する参考サンプルです．
単にエクスプローラを起動するだけであれば，後述の ShellExecuteEx の記事に書いてあるサンプルコードのように，ShellExecute 関数を使用して起動できます．		 


//=============================================================================
//  ShellExecute関数でエクスプローラを起動
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellExecute(Handle, nil, 'explorer.exe', nil, nil, SW_SHOW);
end;

//=============================================================================
//  ShellExecute関数でエクスプローラを起動
//  起動時にディレクトリ D:\ を展開する例
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  ShellExecute(Handle, nil, 'explorer.exe', 'D:\', nil, SW_SHOW);
end;


Windows のエクスプローラの実行ファイルは explorer.exe，インターネット・エクスプローラ (IE) はIEXPLORE.EXE ですが，共通に使用されているインターフェイス (オブジェクト) があります．このページのサンプルコードは，このインターフェイスである IWebBrowser2 を使用しています．
ShellWindows オブジェクトは，Windows のシェルに属する開いたウィンドウのコレクションで，このサンプルではこのウィンドウを新規に作成したり，表示中のウィンドウを操作します．

サンプルを IDE 上でコンパイルして実行すると (管理者権限で実行すると)，下図のように「クラスが登録されていません」というダイアログが現れる場合があります．この場合は，作成した EXE を直接実行してください．この現象は，Windows Vista で導入された UIPI によるものと思われます．
TShell コンポーネントを使用するサンプルでは現れません．

TShell については以下のリンクの記事を参考にしてください．



図1
IDE から実行した場合
  • このダイアログが表示されたら，作成した EXE を直接実行する
  • TShell を使用したサシンプルでは発生しない




01_CreateComObject で新規起動


CoShellBrowserWindow で新規に IWebBrowser2 オブジェクトを生成し，エクスプローラを起動して表示します．CoShellBrowserWindow は，実際には内部で CreateComObject を実行しています．
エクスプローラを操作して，表示フォルダを変更します．[エクスプローラを閉じる] ボタンをクリックすると，表示したエクスプローラを閉じます．


図2
設計時画面
図3
[エクスプローラ起動] クリック
  • プロジェクトのフォルダ内を表示
  • 位置と表示サイズも設定
図4
[表示フォルダ変更] クリック
  • 表示フォルダを C:\ に変更

リスト1
エクスプローラを新規起動 
unit Unit1;

interface

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

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 : IWebBrowser2;
    IEHandle : HWND;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  新規にIE(Internet Explorer)オブジェクトを作成してフォルダ内を表示
//  ここで設定しているツールバーや位置サイズの設定はこのプログラム内のみで有効
//
//  CoShellBrowserWindowはusesにComObjが必要
//  CoShellBrowserWindowは内部でCreateComObjectを実行している
//  定数値READYSTATE_INTERACTIVEの使用にはusesにSHDocVwが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AURL  : String;
  Flags : OleVariant;
begin
  //表示するのはこのプロジェクトのフォルダ内
  AURL := ExtractFileDir(Application.ExeName);

  if GetWindow(IEHandle, 0) = 0 then begin
    //プログラム開始時点でFalseにしておくとよい
    Button2.Enabled := False;
    Button3.Enabled := False;

    //エクスプローラのオブジェクトを生成
    IEObj := CoShellBrowserWindow.Create;

    IEObj.ToolBar    := 0;      //ツールバーの表示
    IEObj.MenuBar    := False;  //メニューバーの表示
    IEObj.AddressBar := False;  //アドレスバーの表示(ToolBarが非表示だと無効)
    IEObj.StatusBar  := True;   //ステータスバーの表示

    //表示位置とサイズを設定
    IEObj.Top    := 0;
    IEObj.Left   := 0;
    IEObj.Width  := 600;
    IEObj.Height := 500;

    IEObj.Visible := True;
  end;


  //フォルダがないとエラーになるのでその対策
  if DirectoryExists(AURL) then begin
    //指定のフォルダを新規にエクスプローラで表示
    //CreateComObjectで新規作成している場合は自動的に新規ウィンドウで表示となる
    Flags := 0;
    IEObj.Navigate(AURL,         //表示するフォルダ
                   Flags,        //各種設定フラグ
                   EmptyParam,   //表示フレームの指定
                   EmptyParam,   //サーバに送信するデータ
                   EmptyParam);  //サーバに送信するHTTPヘッダ

    //表示完了まで待つ
    while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
      Application.ProcessMessages;
    end;
    Button2.Enabled := True;
    Button3.Enabled := True;

    //開いたIEの操作用にIEのハンドル値を取得しておく
    //フルパスの取得はLocationURL.ただしfile:があるので処理が必要
    IEHandle     := IEObj.HWnd;
    Self.Caption := IntToStr(IEHandle) + '  ' + IEObj.LocationName;
  end;
end;
//=============================================================================
//  IEオブジェクトの操作例
//  表示するフォルダをC:\に変更
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  AURL : String;
begin
  Button2.Enabled := False;
  Button3.Enabled := False;

  AURL := 'C:\';

  if Assigned(IEObj) and (GetWindow(IEHandle, 0) >0) then begin
    //フォルダがないとエラーになるのでその対策
    if DirectoryExists(AURL) then begin
      IEObj.Navigate(AURL,         //表示するフォルダ
                     0,            //各種設定フラグ
                     EmptyParam,   //表示フレームの指定
                     EmptyParam,   //サーバに送信するデータ
                     EmptyParam);  //サーバに送信するHTTPヘッダ

      //表示完了まで待つ
      while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
        Application.ProcessMessages;
      end;

      //開いたIEの操作用にIEのハンドル値を取得しておく(Button1Clickの取得値と同じ)
      //LocationNameはフルパスではなくフォルダ名のみ
      IEHandle     := IEObj.HWnd;
      Self.Caption := IntToStr(IEHandle) + '  ' + IEObj.LocationName;

      Button2.Enabled := True;
      Button3.Enabled := True;
    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;

  Button2.Enabled := False;
  Button3.Enabled := False;
end;

end.



02_CreateComObject で新規起動 表示形式を変更


CoShellBrowserWindow で新規に IWebBrowser2 オブジェクトを生成し，エクスプローラを起動して表示します．CoShellBrowserWindow は，実際には内部で CreateComObject を実行しいます．
表示したフォルダの表示形式を [一覧] や [小さいアイコン] 等に変更します．[エクスプローラを閉じる] ボタンをクリックすると，表示したエクスプローラを閉じます．
この後の [04_TShellWindows 新規起動して表示形式を変更] では，これと全く同じ動作を，TShell コンポーネントを使用して行っています．
Windows Vista，Windows 7 には，左ペインの切換えの機能はありません．


図5
設計時画面
図6
[大アイコン]
  • Windows 7 の場合

下図は，[左ペイン切換え] ボタンをクリックした結果です．これはトグル動作となっています．
この動作は Windows XP だけの機能です．


図7
[左ペイン切換え] をクリック
図8
再度 [左ペイン切換え] クリック

リスト2
エクスプローラを新規起動して表示形式を変える 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button20: 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 Button9Click(Sender: TObject);
    procedure Button20Click(Sender: TObject);
  private
    { Private 宣言 }
    IEObj    : IWebBrowser2;
    IEHandle : HWND;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  新規にIE(Internet Explorer)オブジェクトを作成してフォルダ内を表示
//  ここで設定しているツールバーや位置サイズの設定はこのプログラム内のみで有効
//
//  CoShellBrowserWindowはusesにComObjが必要
//  CoShellBrowserWindowは内部でCreateComObjectを実行している
//  定数値READYSTATE_INTERACTIVEの使用にはusesにSHDocVwが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AURL  : String;
  Flags : OleVariant;
begin
  //表示するのはこのプロジェクトのフォルダ内
  AURL := ExtractFileDir(Application.ExeName);

  if GetWindow(IEHandle, 0) = 0 then begin

    //エクスプローラのオブジェクトを生成
    IEObj := CoShellBrowserWindow.Create;

    IEObj.ToolBar    := 0;      //ツールバーの表示
    IEObj.MenuBar    := False;  //メニューバーの表示
    IEObj.AddressBar := False;  //アドレスバーの表示
    IEObj.StatusBar  := True;   //ステータスバーの表示

    //表示位置とサイズを設定
    IEObj.Top    := 100;
    IEObj.Left   := 100;
    IEObj.Width  := 600;
    IEObj.Height := 500;

    IEObj.Visible := True;
  end;

  //フォルダがないとエラーになるのでその対策
  if DirectoryExists(AURL) then begin
    //指定のフォルダを新規にエクスプローラで表示
    //CreateOleObjectで新規作成している場合は自動的に新規ウィンドウで表示となる
    Flags := 0;
    IEObj.Navigate(AURL,         //表示するフォルダ
                   Flags,        //各種設定フラグ
                   EmptyParam,   //表示フレームの指定
                   EmptyParam,   //サーバに送信するデータ
                   EmptyParam);  //サーバに送信するHTTPヘッダ

    //表示完了まで待つ
    while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
      Application.ProcessMessages;
    end;

    //開いたIEの操作用にIEのハンドル値を取得しておく
    //フルパスの取得はLocationURL.ただしfile:があるので処理が必要
    IEHandle     := IEObj.HWnd;
    Self.Caption := IntToStr(IEHandle) + '  ' + IEObj.LocationName;
  end;
end;

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//  エクスプローラのファイルリスト部のクラス名検出に使用
//-----------------------------------------------------------------------------
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のコールバック関数
//  エクスプローラのファイルリスト部のウィンドウハンドル取得に使用
//  クラス名がSHELLDLL_DefViewだったら，その時のウィンドウハンドルを引数に返す
//-----------------------------------------------------------------------------
function EnumChildWndProc(hWindow: hWnd; lPar: PNativeInt):
  Boolean; Stdcall;
begin
  Result := True;

  //子ウィンドウのクラス名が引数の値と同じだったら検索終了
  if GetWindowClassNameStr(hWindow) = 'SHELLDLL_DefView' then begin
    lPar^ := hWindow;
    Result := False;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [写真]
//  Windows 7  : [特大アイコン]
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704D, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702F, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [縮小版]
//  Windows 7  : [大アイコン]
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704F, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702D, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [アイコン]
//  Windows 7  : [中アイコン]
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704E, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $7029, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : 変更なし
//  Windows 7  : [小アイコン]
//=============================================================================
procedure TForm1.Button5Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $7050, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [一覧]
//  Windows 7  : [一覧]
//=============================================================================
procedure TForm1.Button6Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $7051, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702B, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [詳細]
//  Windows 7  : [詳細]
//=============================================================================
procedure TForm1.Button7Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704B, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702C, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [並べて表示]
//  Windows 7  : [並べて表示]
//=============================================================================
procedure TForm1.Button8Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704C, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702E, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  左ペインの表示切り換え
//  [表示][エクスプローラバー]の[フォルダ]チェック状態を変更(トグル動作)
//
//  Windows XP 専用
//  Windows Vista, Windows 7 いは，左ペインの切換え機能はない
//=============================================================================
procedure TForm1.Button9Click(Sender: TObject);
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) >0) then begin
    if CheckWin32Version(6, 0) = False then begin
      PostMessage(IEHandle, WM_COMMAND, $A235, 0);
    end;
  end;
end;

//=============================================================================
//  IEオブジェクトを閉じて切断
//  QuitとUnassignedを使用
//=============================================================================
procedure TForm1.Button20Click(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.



03_TShellWindows 新規起動して表示フォルダを変更


TShell コンポーネントを利用した例です．このサンプルはエクスプローラを新規に起動して，単に表示フォルダを変更するだけです．


図9
設計時画面
図10
[エクスプローラ] クリック
図11
[表示フォルダ変更] クリック

リスト3
TShell コンポーネントを利用したエクスプローラの操作 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  新規にエクスプローラを，フォルダを指定して表示
//  フォームにTShellコンポーネントを配置
//
//  このサンプルでは位置とサイズを指定しているが，非表示で起動できないので，
//  一瞬デフォルトの位置とサイズで表示される(チラツく)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir      : String;
  SHWindows : TShellWindows;
  Count     : Integer;
begin
  //表示するフォルダ(このプログラムのAAA)
  ADir := ExtractFilePath(Application.ExeName) + 'AAA';

  if GetWindow(IEHandle, 0) = 0 then begin
    //まず今現在開いているShellWindowsの数を調査
    //この数が1つ増えたら新しいエクスプローラ起動済みと判断
    SHWindows := TShellWindows.Create(Self);
    try
      Count := SHWindows.Count;

      //新規エクスプローラ表示開始
      //Shell1はフォームに配置したTShellコンポーネント
      Shell1.Explore(ADir);

      //表示完了まで待つ
      //TShellWindowの数が1つ増えるまで待つ
      while SHWindows.Count <= Count do begin
        Application.ProcessMessages;
      end;

      //エクスプローラのオブジェクトを取得
      IEObj := SHWindows.Item(SHWindows.Count-1) as IWebBrowser2;

      //サイズと位置等を指定
      IEObj.Top        := 0;
      IEObj.Left       := 0;
      IEObj.Width      := 600;
      IEObj.Height     := 500;
      IEObj.AddressBar := False;
      //後の操作のためにハンドル値を取得
      IEHandle := IEObj.HWnd;

      Self.Caption := IntToStr(IEHandle) + '  ' + ADir;
    finally
      FreeAndNil(SHWindows);
    end;
  end;
end;

//=============================================================================
//  表示するフォルダを変更
//
//  Naviageメソッドの第2引数は以下の組み合わせ
//  navOpenInNewWindow = $01; 新しいウィンドウを開いて表示
//  navNoHistory       = $02; 履歴に追加しない
//  navNoReadFromCache = $04; ページ表示にディスクキャッシュを使用しない
//  navNoWriteToCache  = $08; 表示ページをディスクキャッシュに書込まない
//  navAllowAutosearch = $10; 失敗したらルートドメイン等を検索して表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  ADir  : String;
  Flags : OleVariant;
begin
  ADir := ExtractFilePath(Application.ExeName) + 'AAA\BB1';

  if Assigned(IEObj) and (GetWindow(IEHandle, 0) >0) then begin
    //フォルダがないとエラーになるのでその対策
    if DirectoryExists(ADir) then begin
      Flags := 0;
      IEObj.Navigate(ADir,         //表示するフォルダ
                     Flags,        //各種設定フラグ
                     EmptyParam,   //表示フレームの指定
                     EmptyParam,   //サーバに送信するデータ
                     EmptyParam);  //サーバに送信するHTTPヘッダ

      //表示完了まで待つ
      while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
        Application.ProcessMessages;
      end;

      //操作用にハンドル値を取得しておく(Button1Clickで取得した値と同じ)
      IEHandle     := IEObj.HWnd;
      Self.Caption := IntToStr(IEHandle) + '  ' + ADir;
    end;
  end else begin
    ShowMessage('表示したエクスプローラは既に閉じています．　');
    IEObj    := nil;
    IEHandle := 0;
  end;
end;

//=============================================================================
//  エクスプローラを閉じて切断
//  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.



04_TShellWindows 新規起動して表示形式を変更


TShell コンポーネントを利用した例です．新規にエクスプローラを起動して表示形式を変更します．
前述の [02_CreateComObject で新規起動 表示形式を変更] の TShell 版です．
Windows Vista，Windows 7 には，左ペインの表示切換えの機能はありません．


図12
設計時画面

リスト4
TShell コンポーネントを利用したエクスプローラの操作 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button20: TButton;
    Shell1: TShell;
    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 Button9Click(Sender: TObject);
    procedure Button20Click(Sender: TObject);
  private
    { Private 宣言 }
    IEObj    : IWebBrowser2;
    IEHandle : HWND;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  新規にエクスプローラを，フォルダを指定して表示
//  フォームにTShellコンポーネントを配置
//
//  このサンプルでは位置とサイズを指定しているが，非表示で起動できないので，
//  一瞬デフォルトの位置とサイズで表示される(チラツく)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir      : String;
  SHWindows : TShellWindows;
  Count     : Integer;
begin
  //表示するフォルダ(このプログラムがあるフォルダ直下のAAAというフォルダ)
  ADir := ExtractFilePath(Application.ExeName) + 'AAA';

  if GetWindow(IEHandle, 0) = 0 then begin
    //まず今現在開いているShellWindowsの数を調査
    //この数が1つ増えたら新しいエクスプローラ起動済みと判断
    SHWindows := TShellWindows.Create(Self);
    try
      Count := SHWindows.Count;

      //新規エクスプローラ表示開始
      //Shell1はフォームに配置したTShellコンポーネント
      Shell1.Explore(ADir);

      //表示完了まで待つ
      //ShellWindowの数が1つ増えるまで待つ
      while SHWindows.Count <= Count do begin
        Application.ProcessMessages;
      end;

      //エクスプローラのオブジェクトを取得
      IEObj := SHWindows.Item(SHWindows.Count-1) as IWebBrowser2;

      //サイズと位置等を指定
      IEObj.Top        := 0;
      IEObj.Left       := 0;
      IEObj.Width      := 600;
      IEObj.Height     := 500;
      IEObj.AddressBar := False;
      //後の操作のためにハンドル値を取得
      IEHandle := IEObj.HWnd;

      Self.Caption := IntToStr(IEHandle) + '  ' + ADir;
    finally
      FreeAndNil(SHWindows);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//  エクスプローラのファイルリスト部のクラス名検出に使用
//-----------------------------------------------------------------------------
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のコールバック関数
//  エクスプローラのファイルリスト部のウィンドウハンドル取得に使用
//  クラス名がSHELLDLL_DefViewだったら，その時のウィンドウハンドルを引数に返す
//-----------------------------------------------------------------------------
function EnumChildWndProc(hWindow: hWnd; lPar: PNativeInt):
  Boolean; Stdcall;
begin
  Result := True;

  //子ウィンドウのクラス名が引数の値と同じだったら検索終了
  if GetWindowClassNameStr(hWindow) = 'SHELLDLL_DefView' then begin
    lPar^  := hWindow;
    Result := False;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [写真]
//  Windows 7  : [特大アイコン]
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704D, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702F, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [縮小版]
//  Windows 7  : [大アイコン]
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704F, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702D, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [アイコン]
//  Windows 7  : [中アイコン]
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704E, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $7029, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : 変更なし
//  Windows 7  : [小アイコン]
//=============================================================================
procedure TForm1.Button5Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $7050, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [一覧]
//  Windows 7  : [一覧]
//=============================================================================
procedure TForm1.Button6Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $7051, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702B, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [詳細]
//  Windows 7  : [詳細]
//=============================================================================
procedure TForm1.Button7Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704B, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702C, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  表示形式を変更
//  Windows XP : [並べて表示]
//  Windows 7  : [並べて表示]
//=============================================================================
procedure TForm1.Button8Click(Sender: TObject);
var
  hTarget : HWND;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(@hTarget));
    if hTarget <> 0 then begin
      if CheckWin32Version(6, 0) then begin
        PostMessage(hTarget, WM_COMMAND, $704C, 0);
      end else begin
        PostMessage(hTarget, WM_COMMAND, $702E, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  左ペインの表示切り換え
//  [表示][エクスプローラバー]の[フォルダ]チェック状態を変更(トグル動作)
//
//  Windows XP 専用
//  Windows Vista, Windows 7 いは，左ペインの切換え機能はない
//=============================================================================
procedure TForm1.Button9Click(Sender: TObject);
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) >0) then begin
    PostMessage(IEHandle, WM_COMMAND, $A235, 0);
  end;
end;

//=============================================================================
//  IEオブジェクトを閉じて切断
//  [940_TWebBrowserとIE]のリスト6と違うのは表示するメッセージ文字列のみ
//  QuitとUnassignedを使用
//=============================================================================
procedure TForm1.Button20Click(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.



05_TShellWindows 新規起動してファイルを選択・選択を検出


TShell コンポーネントを利用した例です．新規起動に起動したエクスプローラで，任意のファイルをコードで選択，またエクスプローラで選択したファイルを自動的に検出して表示します．


図13
設計時画面
  • TShell コンポと TShellFolderView コンポを配置
図14
Button1 クリック
  • このプログラムのフォルダ直下の AAA というフォルダ内を表示
図15
Button2 クリック
  • BB2 というフォルダを選択して編集状態にする
図16
ファイルを選択すると...
図17
選択ファイルを表示
  • エクスプローラで選択したファイルを自動で TMemoに 表示

リスト5
エクスプローラのファイルをコードで選択，選択したファイルを表示 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    Shell1: TShell;
    ShellFolderView1: TShellFolderView;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ShellFolderView1SelectionChanged(Sender: TObject);
  private
    { Private 宣言 }
    IEObj    : IWebBrowser2;
    IEHandle : HWND;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  新規にエクスプローラを，フォルダを指定して表示
//  フォームにTShellとTShellFolderViewコンポーネントを配置
//
//  このサンプルでは位置とサイズを指定しているが，非表示で起動できないので，
//  一瞬デフォルトの位置とサイズで表示される(チラツく)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir      : String;
  SHWindows : TShellWindows;
  Count     : Integer;
begin
  //表示するフォルダ(このプログラムを起動したフォルダ内ののAAAというフォルダ)
  ADir := ExtractFilePath(ParamStr(0)) + 'AAA';

  if GetWindow(IEHandle, 0) = 0 then begin
    //まず今現在開いているShellWindowsの数を調査
    //この数が1つ増えたら新しいエクスプローラ起動済みと判断
    SHWindows := TShellWindows.Create(Self);
    try
      Count := SHWindows.Count;

      //新規エクスプローラ表示開始
      //Shell1はフォームに配置したTShellコンポーネント
      Shell1.Explore(ADir);

      //表示完了まで待つ
      //ShellWindowの数がつ増えるまで待つ
      while SHWindows.Count <= Count do begin
        Application.ProcessMessages;
      end;

      //エクスプローラのオブジェクトを取得
      IEObj := SHWindows.Item(SHWindows.Count-1) as IWebBrowser2;

      //サイズと位置等を指定
      IEObj.Top        := 0;
      IEObj.Left       := 0;
      IEObj.Width      := 600;
      IEObj.Height     := 500;
      IEObj.AddressBar := False;
      //後の操作のためにハンドル値を取得
      IEHandle := IEObj.HWnd;

      Self.Caption := IntToStr(IEHandle) + '  ' + ADir;

      //少々ややこしいが，InternetExplorerのDocumentをShellFolderViewとして
      //TShellFolderViewに接続する
      //これでShellFolderViewオブジェクトの操作が可能となる
      //TShellFolderViewはエクスプローラの右ペインのListView部分のオブジェクト
      ShellFolderView1.ConnectTo(IEObj.Document as ShellFolderView);
    finally
      FreeAndNil(SHWindows);
    end;
  end;
end;

//=============================================================================
//  コードでファイルを選択
//
//  SelectItemの第2引数には以下のものがある
//　 0  アイテムを外す
//　 1  アイテムを選択
//　 3  編集モードにする
//　 4  指定されたアイテム以外を外す
//　 8  アイテムが可視領域に表示されることを確保
//　16  フォーカスを与える
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  SHFolderItem : Shell32_TLB.FolderItem;
  vFolderItem  : OleVariant;
begin
  if Assigned(IEObj) then begin
　　//このプログラムが生成したIEがあれば実行
    if GetWindow(IEHandle, 0) > 0 then begin

      //現在表示中のフォルダ内のBB2というファイルを選択
      SHFolderItem := ShellFolderView1.Folder.ParseName('BB2');

      //SelectItemの第1引数はVariantでvar渡しなので変換
      vFolderItem := OleVariant(SHFolderItem);
      ShellFolderView1.SelectItem(vFolderItem, 3);
    end;
  end;
end;

//=============================================================================
//  エクスプローラを閉じて切断
//  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;

//=============================================================================
//  ShellFolderView1のOnSelectionChangedイベント
//  フォルダやファイルが選択されると発生する
//
//  ここでは選択したファイルのフルパスをTMemoに表示
//  Memo1のWordWrapはFalseにしている
//=============================================================================
procedure TForm1.ShellFolderView1SelectionChanged(Sender: TObject);
var
  Count        : Integer;
  i            : Integer;
  SHFolderItem : Shell32_TLB.FolderItem;
begin
  Memo1.Clear;

  //選択されているItemの数
  Count := ShellFolderView1.SelectedItems.Count;
  for i := 0 to Count - 1 do begin
    SHFolderItem := ShellFolderView1.SelectedItems.Item(i);
    Memo1.Lines.Add(SHFolderItem.Path);
  end;
end;

end.



06_TShellWindows 起動中のエクスプローラを操作


起動中 (表示中) のエクスプローラで，選択しているファイルを検出，また，表示フォルダを変更します．TShell コンポーネントを使用しています．

操作は，エクスプローラのオブジェクト，あるいはその関連オブジェクトに対して実行します．したがって，エクスプローラのオブジェクトを取得すれば，エクスプローラの新規起動の場合でも，起動中のエクスプローラでも同じです．
そのことを確認するためのサンプルです．


図18
設計時画面
図19
Button2 クリック
  • 表示中のエクスプローラで選択していたファイルを表示

リスト6
TShell コンポーネントを利用して表示中のエクスプローラを操作 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses HTTPApp;

{$R *.dfm}

//=============================================================================
//  表示中のエクスプローラのオブジェクトを取得
//  表示中のエクスプローラの操作用のサンプルコード
//
//  各種操作は他のサンプルコードまたはMSDNを参照
//  UnixPathToDosPathの使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SHWindows  : TShellWindows;
  i          : Integer;
  FolderName : String;
begin
  if GetWindow(IEHandle, 0) = 0 then begin
    //現在開いているエクスプローラは複数のことがある
    //ここでは最後に起動したエクスプローラを対象とする
    SHWindows := TShellWindows.Create(Self);
    try
      //ShellWindowsにはIEも含まれるのでfile:が含まれるものだけを対象とする
      for i := SHWindows.Count -1 downto 0 do begin
        //見えないShellウィンドウがあると例外発生が発生するらしいのでその対策
        try
          //エクスプローラのオブジェクトを取得
          IEObj      := SHWindows.Item(i) as IWebBrowser2;
          FolderName := IEObj.LocationURL;

          if Pos('file:', FolderName) > 0 then begin
            //後の操作のためにハンドル値を取得
            IEHandle := IEObj.HWnd;

            //ローカルフォルダやLAN上のフォルダにはfile:という文字が先頭にある
            //このfile://等を削除
            FolderName := StringReplace(IEObj.LocationURL, 'file:///', '', []);
            FolderName := StringReplace(IEObj.LocationURL, 'file://',  '', []);
            //日本語版Windowsでは/を\記号に変換
            FolderName   := UnixPathToDosPath(FolderName);
            Self.Caption := IntToStr(IEHandle) + '  ' + FolderName;
            break;
          end;
        except
        end;
      end;
    finally
      FreeAndNil(SHWindows);
    end;

    if IEHandle = 0 then begin
      ShowMessage('エクスプローラは1つも開いていません．　');
    end;
  end;
end;

//=============================================================================
//  現在選択中のファイルのフルパスを表示
//  TShellFolderViewコンポーネントを使用
//  表示フォルダを変更した場合は，最初のItemが選択と判断される
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  SHFolderView : TShellFolderView;
begin
  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin

    SHFolderView := TShellFolderView.Create(Self);
    try
      //少々ややこしいが，ExplorerのDocumentをShellFolderViewとして
      //TShellFolderViewに接続する
      //これでShellFolderViewオブジェクトの操作が可能となる
      //TShellFolderViewはエクスプローラの右ペインのListView部分のオブジェクト
      SHFolderView.ConnectTo(IEObj.Document as ShellFolderView);
      if SHFolderView.SelectedItems.Count > 0 then begin
        ShowMessage(SHFolderView.FocusedItem.Path);
      end;
    finally
      FreeAndNil(SHFolderView);
    end;
  end;
end;

//=============================================================================
//  表示するフォルダをC:\に変更
//
//  Naviageメソッドの第2引数は以下の組み合わせ
//  navOpenInNewWindow = $01; 新しいウィンドウを開いて表示
//  navNoHistory       = $02; 履歴に追加しない
//  navNoReadFromCache = $04; ページ表示にディスクキャッシュを使用しない
//  navNoWriteToCache  = $08; 表示ページをディスクキャッシュに書込まない
//  navAllowAutosearch = $10; 失敗したらルートドメイン等を検索して表示
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  ADir  : String;
  Flags : OleVariant;
begin
  ADir := 'C:\';

  if Assigned(IEObj) and (GetWindow(IEHandle, 0) > 0) then begin
    //フォルダがないとエラーになるのでその対策
    if DirectoryExists(ADir) then begin
      Flags := 0;
      IEObj.Navigate(ADir,         //表示するフォルダ
                     Flags,        //各種設定フラグ
                     EmptyParam,   //表示フレームの指定
                     EmptyParam,   //サーバに送信するデータ
                     EmptyParam);  //サーバに送信するHTTPヘッダ

      //表示完了まで待つ
      while IEObj.ReadyState < READYSTATE_INTERACTIVE do begin
        Application.ProcessMessages;
      end;

      //操作用にハンドル値を取得しておく(Button1Clickと同値)
      IEHandle := IEObj.HWnd;
      Self.Caption := IntToStr(IEHandle) + '  ' + ADir;
    end;
  end else begin
    ShowMessage('対象のエクスプローラは既に閉じています．　');
    IEObj := nil;
    IEHandle := 0;
  end;
end;

end.



07_TShell の Open メソッドで特殊フォルダを新規表示


TShell コンポーネントの Open メソッドの使用例です．Open メソッドは特殊フォルダ表示用の専用メソッドです．ここではデスクトップを表示します．


図20
設計時画面
図21
Button1 クリック
  • デスクトップ (?) を表示

リスト7
TShell コンポーネントの Open メソッドで特殊フォルダを表示 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  新規にエクスプローラを起動して特殊フォルダを表示
//  フォームにTShellコンポーネントを配置
//  特殊フォルダを開くのにはTShellのOpenメソッドを使用する
//
//  このサンプルでは位置とサイズを指定しているが，非表示で起動できないので，
//  一瞬デフォルトの位置とサイズで表示される(チラツく)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SHWindows : TShellWindows;
  Count     : Integer;
begin
  if GetWindow(IEHandle, 0) = 0 then begin
    //まず今現在開いているShellWindowsの数を調査
    //この数が1つ増えたら新しいエクスプローラ起動済みと判断
    SHWindows := TShellWindows.Create(Self);
    try
      Count := SHWindows.Count;

      //新規エクスプローラ表示開始
      //Shell1はフォームに配置したTShellコンポーネント
      //特殊フォルダの指定子はShell32_TLB.pasを参照(ssfDESKTOPを[Ctrl]+クリック)
      Shell1.Open(ssfDESKTOP);

      //表示完了まで待つ
      //ShellWindowの数がつ増えるまで待つ
      while SHWindows.Count <= Count do begin
        Application.ProcessMessages;
      end;

      //エクスプローラのオブジェクトを取得
      IEObj := SHWindows.Item(SHWindows.Count-1) as  IWebBrowser2;

      //サイズと位置等を指定
      IEObj.Top        := 0;
      IEObj.Left       := 0;
      IEObj.Width      := 600;
      IEObj.Height     := 500;
      IEObj.AddressBar := False;
      //後の操作のためにハンドル値を取得
      IEHandle := IEObj.HWnd;

      Self.Caption := IntToStr(IEHandle) + '  ' + IEObj.LocationName;
    finally
      FreeAndNil(SHWindows);
    end;
  end;
end;

//=============================================================================
//  エクスプローラを閉じて切断
//  QuitとUnassignedを使用
//=============================================================================
procedure TForm1.Button2Click(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.



08_ShellExecuteEx でルートフォルダを指定して新規起動


一般に，他のアプリケーションのプロパティや関数類は，別のアプリからは操作できません．COM はこれらを他のプログラム言語からも利用できるようにするための仕組です．
ComObj, Shell32_TLB, SHDocVw には，COM として公開しているエクスプローラの機能にアクセスするためのコードが実装されています．このコードは「ActiveX の取り込み」や「タイプライブラリの取り込み」で作成することもできます．もちんろん，Delphi でも COM を実装したアプリケーションを作成するができ，開発したアプリの機能を他の言語から利用可能にすることができます．
ここまでのサンプルは，CreateComObject, TShellWindows 等で COM のインターフェイスを利用することにより，いろいろな操作ができました．

これらの操作が必要なければ，エクスプローラは，ShellExecuteEx 関数や CreateProcess 関数でも起動できます．アプリケーションには，起動オプション，コマンドラインオプションが指定できるものがあります．起動時にこれらを指定すると，起動時の状態を設定することができます．

次のサンプルは，ShellExecuteEx 関数でエクスプローラを新規に起動して表示します．
サンプルではルートフォルダを指定して，ShellExecuteEx 関数で起動していますが，左ペインにエクスプローラーバーが表示されますので，単にフォルダ指定による表示と変りがない気もします．

当然ですが，ShellExecuteEx 関数や CreateProcess 関数でエクスプローラを起動しても，エクスプローラのオブジェクトを取得すれば，これまでのサンプルのように操作できます．



図22
設計時画面
図23
実行結果

リスト8
ルートフォルダを指定してエクスプローラを起動 
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 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShellAPI;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  ShellExecuteExでファイル表示
//  ShellExecuteExはファイル(拡張子)の関連付けでアプリを起動する
//
//  SEE_MASK_NOCLOSEPROCESS 
//    ShellExcuteEx実行後，プロセスを維持Processにプロセスのハンドルを返す
//  SEE_MASK_FLAG_NO_UI  
//    エラー発生時にメッセージBoxを表示しない
//
//  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;

//=============================================================================
//  ShellExecuteExでエクスプローラを新規起動
//  TShellExecuteInfo構造体のlpFileのファイル(拡張子)の関連付けでファイルを表示
//  するのであるが，EXEの実行も可能
//
//  このコードでは，左ペインをフォルダツリーにし，ルートフォルダも指定している
//  起動後にエクスプローラのオブジェクトを取得しておけば各種操作も可能
//
//  explorer.exeの起動オプション
//
// n              左ペインはデフォルト表示
// e              左ペインはフォルダツリー表示
// root,object    objectで指定されたフォルダをルートとして表示する
// select,object  objectで指定したフォルダやファイルを選択状態にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  RootDir : String;
  AppStr  : String;
  AppCmd  : String;
begin
  //表示するフォルダ
  RootDir := ExtractFilePath(ParamStr(0)) + 'AAA';

  //フルパスでなくても起動可能
  AppStr := 'explorer.exe';
  AppCmd := '/e, /root, ' + RootDir;

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

end.


特殊フォルダは，もちろんフルパスを指定してもいいのですが，次のように，shell コマンドを指定すると開くことができます．shell コマンドを使用すれば，仮想フォルダも表示可能です．
このコードは，現在のユーザのマイドキュメントのフォルダを表示します．		 



//=============================================================================
//  ShellExecuteExで特殊フォルダをエクスプローラを新規起動して開く
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AppStr  : String;
  AppCmd  : String;
begin
  AppStr := 'explorer.exe';
  AppCmd := 'shell:Personal';

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


Shell:XXX は，それ自体シェルコマンドです．したがって，次のコードでも指定のフォルダを開いて表示することができます．'shell:Libraries' は [ライブラリ] のフォルダを意味します． 


//=============================================================================
//  Shellコマンドでエクスプローラを開く
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AppStr : String;
  AppCmd : String;
begin
  AppStr := 'shell:Libraries';
  AppCmd := '';

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


TShell コンポーネントの ShellExecute メソッドは，シェルコマンドを実行するメソッドです．これを使用すると次のように書けます． 


procedure TForm1.Button1Click(Sender: TObject);
begin
  Shell1.ShellExecute('shell:Libraries');
end;


既に述べたように，起動するエクスプローラに対して何かの操作をする必要がなく，単にエクスプローラを起動するだけであれば，ShellExecute 関数等でも十分です．

上のサンプルでも使用していますが，エクスプローラには起動オプションがあります．前の方のサンプルにもありましたが，指定ファイルを選択状態にするは，次のコードのように「/select,」 オプションを使用します．オプション文字のカンマの後に選択するファイルのフルパスを指定します．
ファイル名に空白文字がある場合は，ダブルクォーテーションで囲むことを忘れないでください． 



//=============================================================================
//  新規にエクスプローラを起動して指定ファイルを選択状態にする
//  ShellExecuteの使用には，usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFile   : String;
  AParams : String;
begin
  AFile := 'Explorer.exe';
  AParams := '/select,' + Application.ExeName;
  ShellExecute(Handle,
               'open',
               PChar(AFile),
               PChar(AParams),
               nil,
               SW_SHOW);
end;


参考までに，この後のサンプルで使用している，エクスプローラのフォルダオプションのダイアログは次のコードで表示できます．RunExeFile は上のサンプルで定義して使用している関数です． 



//=============================================================================
//  ShellExecuteExでフォルダオプションのダイアログを表示
//  [表示]タブをアクティブにして表示する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AppStr  : String;
  AppCmd  : String;
begin
  AppStr := 'rundll32.exe';
  AppCmd := 'shell32.dll,Options_RunDLL 7';

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


ShellExecute 関数を使用する場合は，例えば次のように書けます．もちろん，CreateProcess 関数でも同じように書けます．次のサンプルを参考にしてください．
ShellExecute 関数や ShellExecuteEx 関数，CreateProcess 関数の違いは参考リンクの [485_アプリの起動とファイルを開く関数] の記事で確認してください． 


//=============================================================================
//  ShellExecuteでフォルダオプションのダイアログを表示
//  [表示]タブをアクティブにして表示する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AppStr  : String;
  AppCmd  : String;
begin
  AppStr := 'rundll32.exe';
  AppCmd := 'shell32.dll,Options_RunDLL 7';
  ShellExecute(Handle,
               'open',
               PChar(AppStr),
               PChar(AppCmd),
               nil,
               SW_SHOW);
end;



09_CreateProcess でルートフォルダを指定して新規起動


CreateProcess 関数でエクスプローラを新規に起動して表示します．
動作は前のサンプルと全く同じです．

エクスプローラのオブジェクトに対する操作が必要なければ，エクスプローラは，ShellExecuteEx 関数や CreateProcess 関数でも起動できます．
また，ShellExecuteEx 関数や CreateProcess 関数でエクスプローラを起動しても，エクスプローラのオブジェクトを取得すれば，これまでのサンプルのように操作できます．



リスト9
ルートフォルダを指定してエクスプローラを起動 
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 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//-----------------------------------------------------------------------------
//  CreaateProcessで指定アプリを起動
//-----------------------------------------------------------------------------
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;

//=============================================================================
//  CreateProcessででエクスプローラを新規起動
//
//  このコードでは，左ペインをフォルダツリーにし，ルートフォルダも指定している
//  起動後にエクスプローラのオブジェクトを取得しておけば各種操作も可能
//
//  explorer.exeの起動オプション
//
// n              左ペインはデフォルト表示
// e              左ペインはフォルダツリー表示
// root,object    objectで指定されたフォルダをルートとして表示する
// select,object  objectで指定したフォルダやファイルを選択状態にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  RootDir : String;
  AppStr  : String;
  AppCmd  : String;
begin
  //表示するフォルダ
  RootDir := ExtractFilePath(ParamStr(0)) + 'AAA';

  //フルパスでなくても起動可能
  AppStr := 'explorer.exe';
  AppCmd := '/e, /root, ' + RootDir;

  AppStr := AppStr + ' ' + AppCmd;
  ExecuteApp(AppStr);
end;

end.


この次のサンプルで表示しているエクスプローラのフォルダーオプションのダイアログの表示は，上の ExecuteApp を使用すると，例えば次のように書けます． 


//=============================================================================
//  CreateProcessでフォルダオプションのダイアログを表示
//  [表示]タブをアクティブにして表示する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AppStr : String;
  AppCmd : String;
begin
  AppStr := 'rundll32.exe';
  AppCmd := 'shell32.dll,Options_RunDLL 7';

  AppStr := AppStr + ' ' + AppCmd;
  ExecuteApp(AppStr);
end;



10_[ フォルダーオプション ] の設定値取得と設定


SHGetSetSettings 関数を使用すると，下図のダイアログの設定である，フォルダーオプションの一部の設定値を取得したり，設定することができます．また，TShell コンポーネントの Shell32_TLB.pas 内にある SHGetSettings 関数でも設定値の取得ができます．
この SHGetSetSettings 関数による設定は，システム全体に対する設定となります．

SHGetSetSettings 関数は Delphi 2010 で実装された関数です．それより前で使用するには，関数の定義コードを実装する必要があります．



図24
フォルダーオプション


下の表は，SHGetSetSettings 関数の第 2 引数で指定可能な値です．1 つ以上を指定します．
表中の '-' は，Windows Vista 以降では使用できないか，未使用の定数値です．


SSF_SHOWALLOBJECTS [ファイルとフォルダの表示]
SSF_SHOWEXTENSIONS [登録されている拡張子は表示ない]
SSF_HIDDENFILEEXTS -
SSF_SERVERADMINUI -
SSF_SHOWCOMPCOLOR [暗号化や圧縮された NTFS ファイルをカラーで表示する]
SSF_SORTCOLUMNS -
SSF_SHOWSYSFILES -
SSF_DOUBLECLICKINWEBVIEW [全般]タブの
[ポイントして選択し，シングルクリックで開く]
[シングルクリックで選択し，ダブルクリックで開く]
SSF_SHOWATTRIBCOL -
SSF_DESKTOPHTML -
SSF_WIN95CLASSIC -
SSF_DONTPRETTYPATH -
SSF_SHOWINFOTIP [フォルダとデスクトップの項目の説明をポップアップで表示]
SSF_MAPNETDRVBUTTON -
SSF_NOCONFIRMRECYCLE ごみ箱への移動の際の確認ダイアログの表示，非表示
SSF_HIDEICONS エクスプローラのリストビューのアイコン表示の状態
動作の確認はできなかった
SSF_FILTER -
SSF_WEBVIEW -
SSF_SHOWSUPERHIDDEN [保護されたオペレーティングシステムファイルを表示しない]
SSF_SEPPROCESS [別のプロセスでフォルダウィンドウを開く]
SSF_NONETCRAWLING -
SSF_STARTPANELON -
SSF_SHOWSTARTPAGE -
SSF_AUTOCHECKSELECT Windows Vista 以降
[チェックボックスを使用して項目を選択する]
SSF_ICONSONLY Windows Vista 以降
[常にアイコンを表示し，縮小版を表示しない]
SSF_SHOWTYPEOVERLAY Windows Vista 以降
[縮小版にファイルアイコンを表示する]
SSF_SHOWSTATUSBAR Windows 8 以降．Delphi XE3 までには定義なし
ステータスバーの表示，非表示 (動作未確認)


フォルダーオプションの設定値の取得と設定のテストプログラムです．
ボタンはトグル操作となっています．チェックボックスの方が良かったかも知れません．


図25
設計時画面
図26
実行開始画面
  • 現在の設定値に応じて，ボタンの Caption の値を設定する
図27
登録されている拡張子
  • この拡張子の表示と非表示を切り替える
  • 左は拡張子を表示した場合
  • 右は拡張子を表示しない場合
図28
ゴミ箱への移動の際のダイアログ
  • このダイアログの表示と非表示を切り替える

リスト10
[フォルダーオプション] の設定値取得と設定のサンプル		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses ShlObj;

{$R *.dfm}

const
  //---------------------------------------------------------------------------
  //  TShellStateレコード型のDataとData2メンバー値のリスト
  //  Data2メンバーの値を使用する場合はShlObj.pasのコードを修正しておく
  //---------------------------------------------------------------------------
  //Dataメンバーの値
  fShowAllObjects       = $00000001;
  fShowExtensions       = $00000002;
  fNoConfirmRecycle     = $00000004;
  fShowSysFiles         = $00000008;
  fShowCompColor        = $00000010;
  fDoubleClickInWebView = $00000020;
  fDesktopHTML          = $00000040;
  fWin95Classic         = $00000080;
  fDontPrettyPath       = $00000100;
  fShowAttribCol        = $00000200;
  fMapNetDrvBtn         = $00000400;
  fShowInfoTip          = $00000800;
  fHideIcons            = $00001000;
  fWebView              = $00002000;
  fFilter               = $00004000;
  fShowSuperHidden      = $00008000;
  fNoNetCrawling        = $00010000;

  //Data2メンバーの値
  fSepProcess      = $00000001;
  fStartPanelOn    = $00000002;
  fShowStartPage   = $00000004;
  fAutoCheckSelect = $00000008;
  fIconsOnly       = $00000010;
  fShowTypeOverlay = $00000020;

//=============================================================================
//  フォーム生成時の処理
//  現在の設定値を取得し，それに応じて各ボタンの表示を変更
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'フォルダーオプションの設定例';

  Button1Click(nil);
  Button2Click(nil);
  Button3Click(nil);
end;

//=============================================================================
//  SHGetSetSettings関数の使用例
//  [登録された拡張子]の表示・非表示のトグル操作
//
//  usesにShlObjが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StateValue : TShellState;
  dwMask     : Cardinal;
  dwMaskData : DWORD;
begin
  //変な値を取得しないように，念のために0クリア
  ZeroMemory(@StateValue, SizeOf(StateValue));

  //取得と設定値の指定
  dwMask     := SSF_SHOWEXTENSIONS;
  dwMaskData := fShowExtensions;

  //現在の設定値を取得
  //第3引数をFalseにすると取得
  SHGetSetSettings(StateValue, dwMask, False);

  if Sender = nil then begin
    if (StateValue.Data and dwMaskData) <> 0 then begin
      Button1.Caption := '登録されている拡張子を非表示にする';
    end else begin
      Button1.Caption := '登録されている拡張子も表示する';
    end;
  end else begin
    if (StateValue.Data and dwMaskData) <> 0 then begin
      StateValue.Data := 0;
      SHGetSetSettings(StateValue, dwMask, True);

      Button1.Caption := '登録されている拡張子も表示する';
    end else begin
      StateValue.Data := dwMaskData;
      SHGetSetSettings(StateValue, dwMask, True);

      Button1.Caption := '登録されている拡張子を非表示にする';
    end;

   //システムに変更を通知
   //SHCNE_ASSOCCHANGEDはファイルタイプの関連付け変更
   //SHCNF_FLUSHNOWAITはシステムのバッファをフラッシュ
   SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSHNOWAIT, nil, nil);
  end;

end;

//=============================================================================
//  SHGetSetSettings関数の使用例
//  ファイルをダブルクリックで開くかシングルクリックで開くかの設定
//
//  usesにShlObjが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  StateValue : TShellState;
  dwMask     : Cardinal;
  dwMaskData : DWORD;
  SHWindows  : TShellWindows;
  IEObj      : IWebBrowser2;
  i          : Integer;
begin
  //変な値を取得しないように，念のために0クリア
  ZeroMemory(@StateValue, SizeOf(StateValue));

  //取得と設定値の指定
  dwMask     := SSF_DOUBLECLICKINWEBVIEW;
  dwMaskData := fDoubleClickInWebView;

  //現在の設定値を取得
  //第3引数をFalseにすると取得
  SHGetSetSettings(StateValue, dwMask, False);

  if Sender = nil then begin
    if (StateValue.Data and dwMaskData) <> 0 then begin
      Button2.Caption := 'シングルクリックで開くようにする';
    end else begin
      Button2.Caption := 'ダブルクリックで開くようにする';
    end;
  end else begin
    if (StateValue.Data and dwMaskData) <> 0 then begin
      StateValue.Data := 0;
      SHGetSetSettings(StateValue, dwMask, True);

      Button2.Caption := 'タブルクリックで開くようにする';
    end else begin
      StateValue.Data := dwMaskData;
      SHGetSetSettings(StateValue, dwMask, True);

      Button2.Caption := 'シングルクリックで開くようにする';
    end;

    //こちらはSHChangeNotifyでは更新されないようである
    //シェルのウィンドウのコレクションを取得
    SHWindows := TShellWindows.Create(Self);

    //それらのウィンドウのハンドルを取得して，エクスプローラであれば
    //[最新の情報に更新]のコマンドを実行
    for i := 0 to SHWindows.Count - 1 do begin
      IEObj := SHWindows.Item(i) as IWebBrowser2;
      if LowerCase(ExtractFileName(IEObj.FullName)) = 'explorer.exe' then begin
        PostMessage(IEObj.HWnd, WM_COMMAND, $A220, 0);
      end;
    end;
  end;

end;

//=============================================================================
//  SHGetSetSettings関数の使用例
//  ゴミ箱に移動する際に，確認のダイアログの表示・非表示の設定
//
//  usesにShlObjが必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  StateValue : TShellState;
  dwMask     : Cardinal;
  dwMaskData : DWORD;
begin
  //変な値を取得しないように，念のために0クリア
  ZeroMemory(@StateValue, SizeOf(StateValue));

  //取得と設定値の指定
  dwMask     := SSF_NOCONFIRMRECYCLE;
  dwMaskData := fNoConfirmRecycle;

  //現在の設定値を取得
  //第3引数をFalseにすると取得
  SHGetSetSettings(StateValue, dwMask, False);

  if Sender = nil then begin
    if (StateValue.Data and dwMaskData) <> 0 then begin
      Button3.Caption := 'ゴミ箱へ移動時の確認ダイアログを表示する';
    end else begin
      Button3.Caption := 'ゴミ箱へ移動時の確認ダイアログを非表示にする';
    end;
  end else begin
    if (StateValue.Data and dwMaskData) <> 0 then begin
      StateValue.Data := 0;
      SHGetSetSettings(StateValue, dwMask, True);

      Button3.Caption := 'ゴミ箱へ移動時の確認ダイアログを非表示にする';
    end else begin
      StateValue.Data := dwMaskData;
      SHGetSetSettings(StateValue, dwMask, True);

      Button3.Caption := 'ゴミ箱へ移動時の確認ダイアログを表示する';
    end;
  end;
end;

end.


Delphi XE の ShlObj.pas 内の TShellState の定義は，MSDN の記事と違う部分があります．
設定値の取得の際に例外が発生したりして悩み，修正を開始したのですが，以下の参考リンクの記事に修正コードがありました．これを利用することにしました．

大元の ShlObj.pas を修正してしまうのを避け，ShlObj.pas をテストプロジェクトのフォルダにコピーして，それを修正して使用しました．Data2 のメンバーの値を使用する場合はこの修正が必要です．Data2 のメンバの値を使用しない場合は，この修正は必要ありません．



リスト11
ShlObj.pas 内の TShellState 型の定義を以下のように修正して使用		 
  tagSHELLSTATEW = record
    Data: DWORD;
{   fShowAllObjects: BOOL:1;
    fShowExtensions: BOOL:1;
    fNoConfirmRecycle: BOOL:1;
    fShowSysFiles: BOOL:1;
    fShowCompColor: BOOL:1;
    fDoubleClickInWebView: BOOL:1;
    fDesktopHTML: BOOL:1;
    fWin95Classic: BOOL:1;
    fDontPrettyPath: BOOL:1;
    fShowAttribCol: BOOL:1;
    fMapNetDrvBtn: BOOL:1;
    fShowInfoTip: BOOL:1;
    fHideIcons: BOOL:1;
    fWebView: BOOL:1;
    fFilter: BOOL:1;
    fShowSuperHidden: BOOL:1;
    fNoNetCrawling: BOOL:1;}

    dwWin95Unused: DWORD;// Win95 only - no longer supported pszHiddenFileExts
    uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts

    // Note: Not a typo!  This is a persisted structure so we cannot use LPARAM
    lParamSort: Integer;
    iSortDirection: Integer;
    version: UINT;

    // new for win2k. need notUsed var to calc the right size of ie4 struct
    // FIELD_OFFSET does not work on bit fields
    uNotUsed: UINT;// feel free to rename and use}

    Data2: DWORD;
{   fSepProcess: BOOL:1;

    // new for Whistler.
    fStartPanelOn: BOOL:1;
    fShowStartPage: BOOL:1;

    // new for Windows Vista
    fAutoCheckSelect: BOOL:1;
    fIconsOnly: BOOL:1;
    fShowTypeOverlay: BOOL:1;

    // If you need a new flag, steal a bit from from fSpareFlags.
    // Also, keep SHELLFLAGSTATE and SHGetSettings in sync when adding new flags.
    fSpareFlag: UINT:13;}
  end;
  {$EXTERNALSYM tagSHELLSTATEW}
  SHELLSTATEA = tagSHELLSTATEW;
  {$EXTERNALSYM SHELLSTATEA}
  SHELLSTATEW = tagSHELLSTATEW;
  {$EXTERNALSYM SHELLSTATEW}
  SHELLSTATE = SHELLSTATEW;
  {$EXTERNALSYM SHELLSTATE}
  TShellState = SHELLSTATE;
  PShellState = ^TShellState;