Delphiで作るシェル拡張(ShellExtention)・・・コンテキストメニューの追加

 このページの一番下にサンプルプログラム(実行ファイルとソース)のダウンロードがあります。LhDesktopは、LHA書庫ファイルを一発でデスクトップに解凍するプログラムとして使用できます。

 Delphi3のデモプログラムの中にContmenu.drp(Demos\Shellexeフォルダ)というものがあります。このプロジェクトをビルドすると、エクスプローラでDelphi Project(*.DPR)を選択しているときのコンテキストメニューに「コンパイル...」というメニュー項目が挿入され、実行するとプロジェクトをコンパイルするようになります。

 ここでは、このデモプログラムをひな形として、LHA書庫ファイルを選択した場合のコンテキストメニューに「デスクトップに解凍」というメニューを追加するプログラムを作成してみます。
 ポイントはGUIDの作成とレジストリへの登録になります。

 初めにレジストリに登録するGUID(グローバルユニークなID)を作成します。デモプログラムを使用して作成したプログラムを、個人的に一つだけ使用するだけならば、デモプログラムで定義されているGUIDをそのまましようしてもかまいませんが、複数作成したい場合や、配布したい場合には新たに作成しなければなりません。

 GUIDの作成にはWin32APIを使用します。以下にサンプルを示します(Form1にButton1とEdit1を乗せてください)。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ActiveX, ComObj;//ActiveX と ComObjを追加してください

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.GenGUID;
var
  AGUID: TGUID;
begin
  if Failed(CoCreateGUID(AGUID)) then
    raise Exception.Create('Connot Create GUID');
  Edit1.Text := GUIDToString(AGUID);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GenGUID;
end;

end.


これでボタンを押すたびに新たなGUIDが作成されます。作成されたGUIDをコピーしてください。
ここで作成したGUIDをデモプログラムのものと置換します。

unit ContextM;

interface
uses
    Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils, Registry;

  //作成したGUIDをコピーして定義します。
  //{6898E0A0-EDA2-11D2-8689-00A0B00AB2BB}
Const
  CLSID_ContextMenuShellExtension: TGUID = (
  D1:$6898E0A0; D2:$EDA2; D3:$11D2; D4:($86, $89, $00, $A0, $B0, $0A, $B2, $BB));

type
  TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  private
    szFile: array[0..MAX_PATH] of Char;
  public
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
                              uFlags: UINT): HResult; stdcall;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
                              pszName: LPSTR; cchMax: UINT): HResult; stdcall;
    function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
                        hKeyProgID: HKEY): HResult; stdcall;
  end;


以下がシェル拡張プログラムの本体です。Delphiのデモプログラムソースも参照してみてください。

implementation

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
                                       idCmdLast, uFlags: UINT): HResult;
begin
  InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
    'デスクトップに解凍');//ここにコンテキストメニューに表示する文字列を指定します。
  // 複数のメニューを追加する場合は上記を繰り返し、Resultに追加したメニューの数をセットします。
  Result := 1;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  // Unlha32.dllを呼び出すための定義を行ないます。この場合では'Unlha'のみを定義します。
  Unlha: function(_hwnd: HWND;szCmdLine, szOutput:pchar;wSize: integer): integer; stdcall;
  HUNLHA: THandle;
  p: TFarProc;
  // 文字列はChar型の配列を使用します。8bit長(255文字)を越えるString型を使用する場合、
  // ShareMemをUsesすればよいことになっていますが、なぜかこの方法を用いると認識されずに
  // コンテキストメニューに表示されません
  DeskTopDir,
  TempDir: array[0..260] of Char;
  reg: TRegistry;
begin
  // Make sure we are not being called by an application
  if HiWord(Integer(lpici.lpVerb)) <> 0 then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Make sure we aren't being passed an invalid argument number
  if LoWord(lpici.lpVerb) > 0 then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;
  // Execute the command specified by lpici.lpVerb.
  if LoWord(lpici.lpVerb) = 0 then
  begin // 以下がUnlha32.dllをコールする処理です
    // UNLHA32.DLLをロードする
    HUNLHA := LoadLibrary('UNLHA32.DLL');
    if HUNLHA = 0 then
      MessageBox(lpici.hWnd, 'UNLHA32.DLLをロードできません.', '実行エラー',
        MB_ICONERROR or MB_OK)
    else begin
      // Unlha APIを定義する
      p := GetProcAddress(HUNLHA,'Unlha');
      if p <> nil then
      begin
        // デスクトップフォルダ名を取得する
        reg := TRegistry.Create;
        reg.RootKey := HKEY_CURRENT_USER;
        if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False) then
        begin
          try
            StrCopy(DeskTopDir, PChar(reg.ReadString('Desktop')));
          finally
            reg.CloseKey;
          end;
        end;
        reg.Free;
        if StrLen(DeskTopDir) = 0 then
          StrCopy(DeskTopDir, 'C:\Windowsデスクトップ');
        if GetTempPath(260, TempDir) = 0 then
          StrCopy(TempDir, 'C:\Windows\Temp');    // 取得できなかった場合
        // Unlhaに引数を設定してコールする
        @UnLha := p;
        if Unlha(HUNLHA, PChar('x -jf1 "' + szFile + '" "' + DeskTopDir + '\'
                               + ChangeFileExt(ExtractFileName(szFile), '')
                               + '\" *.* -w' + TempDir), nil, 0) <> 0 then
          MessageBox(lpici.hWnd, 'Unlha32.dll を実行出来ません.', '実行エラー',
            MB_ICONERROR or MB_OK);
        Freelibrary(HUNLHA);
      end else
        MessageBox(lpici.hWnd, 'UNLHA32.DLLをロードできません.', '実行エラー',
            MB_ICONERROR or MB_OK);
      end;
    end;
    Result := NOERROR;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  if idCmd = 0 then
  begin
    // エクスプローラのステータスバーに表示される説明文を指定します
    strCopy(pszName, 'LhDesktopでLHA書庫をデスクトップに解凍します.');
    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;
end;

// この処理はファイルを選択して右クリックした時点で呼ばれます
// 最初に選択されたファイル情報を取得して成功した場合にのみ
// コンテキストメニューへのメニュー項目追加処理が呼ばれる様に
// しているんですね
function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  medium: TStgMedium;
  fe: TFormatEtc;
begin
  with fe do
  begin
    cfFormat := CF_HDROP;
    ptd := Nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  // Fail the call if lpdobj is Nil.
  if lpdobj = Nil then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result := lpdobj.GetData(fe, medium);
  if Failed(Result) then Exit;
  // この場合には選択されているファイルが一つだけというのを前提にしています。
  // 複数のファイルを処理する場合には、
  // n := DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0);
  // if n > 0 then
  // begin
  //   for i := 0 to n - 1 do
  //   begin
  //     DragQueryFile(medium.hGlobal, i, szFile, SizeOf(szFile))
  //     szFileに取得したファイル名を追加する処理
  //   end;
  // end;
  // として全てのファイル名を取得します
  // 尚、取得したファイル名はDOSの8.3形式になっていますので、必要に応じて
  // ロングファイルネールに変換してください
  if DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
  begin
    DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
    Result := NOERROR;
  end
  else
    Result := E_FAIL;
  ReleaseStgMedium(medium);
end;

initialization
    TComObjectFactory.Create(ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
         '', 'LhDesktop ContextMenu', ciMultiInstance);
end.


 上記のプログラムはデモプログラムを少しいじっただけです。とても簡単につくれてしまいます。でも何か落とし穴があるような・・・実はあるんですね(後述)

 シェル拡張プログラム(DLL)は簡単に作成できましたが、このプログラムだけでは動作しません。実際に動作させるためにはレジストリへの登録が必要になります。

 レジストリへの登録は、HKEY_CLASSES_ROOTにおいてファイル拡張子とGUIDを結びつける作業となります。この場合にはDLLを登録することになりますが、結びつけようとする拡張子が、既に何らかのアプリケーションと関連づけられているかどうかで、登録方法が異なります。

1.アプリケーションの関連付けがない場合
 直接拡張子名のキーを作成し、その下に登録する。この場合にはLHA書庫ファイルに結びつけるので、キー名は'.lzh'となります。

 '.lzh'キーを作成し、その下に'shellex\ContextMenuHandlers\LhDesktp'というキーを登録する。次に(標準)のデータにGUIDを設定する。
 もしくは、'shellex\ContextMenuHandlers\'に直接GUID名のキーを作成して、(標準)のデータを空白にしてもよい。

 次に同じくHKEY_CLASSES_ROOTにある'CLSID'キーの下にGUID名のキーを作成し、

 その下に'InProcServer32'キーを作成し(標準)のデータに作成したDLLのファイル名をフルパスで設定し、次に文字列を新規作成し、名称を'ThreadingModel',データを'Apartment'に設定します。

 以上で登録は完了です。
 この登録を行なうと、LHA書庫ファイルを選択して右クリックすると、

 コンテキストメニューの一番上に「デスクトップに解凍」が追加されます(他に何も登録されていないので、「デスクトップに解凍」が標準の処理になります)。

2.既に.lzhがアプリケーションに関連付けされている場合

 この場合には、(標準)にエクスプローラの「ファイルの種類」に表示される何らかの名前が登録されています。関連付けの実態はこの名前のキーに格納されているので、このキーを探します。

 このキーの下に1.と同様の登録を行ないます。


 この方法で登録した場合には、「開く(O)」の下にメニューが挿入されています。


 実際の登録にあたっては使用者に対して上記のような作業を要求するわけにはいかないので、何らかのインストールプログラムを使用することになると思います。

落とし穴:
 上記の例ではファイルに対する処理を行なうだけで、使用上は何の問題もおきません。
 実は関連付けは特定のファイルに対する物だけではなく、
 '.*'キー     ・・・全てのオブジェクト(ファイル)
 'Folder'キー  ・・・全てのフォルダ
 'Directory'キー・・・全てのディレクトリ
 'Drive'キー   ・・・全てのドライブ
 に対しても行なうことができます。
 上記の内、'.*'キーについては何の問題もないのですが、他のキーに関連付けした場合に問題が発生します。
 具体的には、エクスプローラのリストビューペイン(右側のファイルやフォルダの一覧が表示されるほう)で処理を行なう分には問題はおきません。
 問題はツリービューペインで処理を行なう場合です。フォルダやドライブはツリービューペインでも同様にコンテキストメニューが表示されるのですが、実際に処理を実行するとエクスプローラが「不正な処理・・・」でダウンしてしまいます。
 ファイル情報の取得〜コンテキストメニュー表示までは正常に処理が行われますが、メニューが選択されてからInvokeCommandがコールされる前にダウンします。おそらく他に準備しなければならない処理関数があるのだと思われますが、それが何かは???です。どなたかご存じの方がいらっしゃいましたら是非教えてください。

 提供するサンプルプログラムには、選択したファイルやディレクトリを圧縮してデスクトップにLHA書庫を作成するShellExtentionプログラムを同梱してあります。勇気のある方はツリービューペインでフォルダを選択して実行してみてください。エクスプローラが落ちるのが体験できます(実行する場合には、必ず他のアプリケーションを全て終了させてから実行してください)。
※サンプルプログラムは「無保証」です。実行する場合には自己の責任においてのみ可能です。
※サンプルプログラムの二次配布は禁止します。
※サンプルプログラム中のInstall.dprは、サイズを小さくするためにFormを用いずに直接Projectソース中にプログラムを埋め込んでいます。このようなプログラムの作成方法でもデバッグが可能なので、小さなプログラムを組む場合は便利です。

サンプルのダウンロード(122,880byte)

※DLLとinstall.exeを同じフォルダにおいて、install.exeを実行するとデータがレジストリに登録されてシェル拡張が有効となります。。解除する場合にはinstall.exeに引数-Uを付けて実行してください(install.exe -U)。