Delphiで作るシェル拡張(ShellExtention)・・・コンテキストメニューの追加
このページの一番下にサンプルプログラム（実行ファイルとソース）のダウンロードがあります。LhDesktopは、LHA書庫ファイルを一発でデスクトップに解凍するプログラムとして使用できます。
Delphi3のデモプログラムの中にContmenu.drp(Demos\Shellexeフォルダ)というものがあります。このプロジェクトをビルドすると、エクスプローラでDelphi Project(*.DPR)を選択しているときのコンテキストメニューに「コンパイル．．．」というメニュー項目が挿入され、実行するとプロジェクトをコンパイルするようになります。
ここでは、このデモプログラムをひな形として、LHA書庫ファイルを選択した場合のコンテキストメニューに「デスクトップに解凍」というメニューを追加するプログラムを作成してみます。
ポイントはGUIDの作成とレジストリへの登録になります。
初めにレジストリに登録するGUID（グローバルユニークなＩＤ）を作成します。デモプログラムを使用して作成したプログラムを、個人的に一つだけ使用するだけならば、デモプログラムで定義されている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.
上記のプログラムはデモプログラムを少しいじっただけです。とても簡単につくれてしまいます。でも何か落とし穴があるような・・・実はあるんですね（後述）
シェル拡張プログラム（ＤＬＬ）は簡単に作成できましたが、このプログラムだけでは動作しません。実際に動作させるためにはレジストリへの登録が必要になります。
レジストリへの登録は、HKEY_CLASSES_ROOTにおいてファイル拡張子とGUIDを結びつける作業となります。この場合にはＤＬＬを登録することになりますが、結びつけようとする拡張子が、既に何らかのアプリケーションと関連づけられているかどうかで、登録方法が異なります。
1.アプリケーションの関連付けがない場合
直接拡張子名のキーを作成し、その下に登録する。この場合にはLHA書庫ファイルに結びつけるので、キー名は'.lzh'となります。
'.lzh'キーを作成し、その下に'shellex\ContextMenuHandlers\LhDesktp'というキーを登録する。次に(標準)のデータにGUIDを設定する。
もしくは、'shellex\ContextMenuHandlers\'に直接GUID名のキーを作成して、(標準)のデータを空白にしてもよい。
次に同じくHKEY_CLASSES_ROOTにある'CLSID'キーの下にGUID名のキーを作成し、
その下に'InProcServer32'キーを作成し(標準)のデータに作成したＤＬＬのファイル名をフルパスで設定し、次に文字列を新規作成し、名称を'ThreadingModel'，データを'Apartment'に設定します。
以上で登録は完了です。
この登録を行なうと、LHA書庫ファイルを選択して右クリックすると、
コンテキストメニューの一番上に「デスクトップに解凍」が追加されます（他に何も登録されていないので、「デスクトップに解凍」が標準の処理になります）。
２．既に.lzhがアプリケーションに関連付けされている場合
この場合には、(標準)にエクスプローラの「ファイルの種類」に表示される何らかの名前が登録されています。関連付けの実態はこの名前のキーに格納されているので、このキーを探します。
このキーの下に１．と同様の登録を行ないます。
- 既に何らかのアプリケーションの関連付けが行われている場合に、１．の方法で登録しても登録内容は無視されます（無視されるだけで悪影響はないようです）。
この方法で登録した場合には、「開く(O)」の下にメニューが挿入されています。
実際の登録にあたっては使用者に対して上記のような作業を要求するわけにはいかないので、何らかのインストールプログラムを使用することになると思います。
落とし穴：
上記の例ではファイルに対する処理を行なうだけで、使用上は何の問題もおきません。
実は関連付けは特定のファイルに対する物だけではなく、
'.*'キー ・・・全てのオブジェクト（ファイル）
'Folder'キー ・・・全てのフォルダ
'Directory'キー・・・全てのディレクトリ
'Drive'キー ・・・全てのドライブ
に対しても行なうことができます。
上記の内、'.*'キーについては何の問題もないのですが、他のキーに関連付けした場合に問題が発生します。
具体的には、エクスプローラのリストビューペイン（右側のファイルやフォルダの一覧が表示されるほう）で処理を行なう分には問題はおきません。
問題はツリービューペインで処理を行なう場合です。フォルダやドライブはツリービューペインでも同様にコンテキストメニューが表示されるのですが、実際に処理を実行するとエクスプローラが「不正な処理・・・」でダウンしてしまいます。
ファイル情報の取得〜コンテキストメニュー表示までは正常に処理が行われますが、メニューが選択されてからInvokeCommandがコールされる前にダウンします。おそらく他に準備しなければならない処理関数があるのだと思われますが、それが何かは？？？です。どなたかご存じの方がいらっしゃいましたら是非教えてください。
提供するサンプルプログラムには、選択したファイルやデｨレクトリを圧縮してデスクトップにLHA書庫を作成するShellExtentionプログラムを同梱してあります。勇気のある方はツリービューペインでフォルダを選択して実行してみてください。エクスプローラが落ちるのが体験できます（実行する場合には、必ず他のアプリケーションを全て終了させてから実行してください）。
※サンプルプログラムは「無保証」です。実行する場合には自己の責任においてのみ可能です。
※サンプルプログラムの二次配布は禁止します。
※サンプルプログラム中のInstall.dprは、サイズを小さくするためにFormを用いずに直接Projectソース中にプログラムを埋め込んでいます。このようなプログラムの作成方法でもデバッグが可能なので、小さなプログラムを組む場合は便利です。
サンプルのダウンロード(122,880byte)
※ＤＬＬとinstall.exeを同じフォルダにおいて、install.exeを実行するとデータがレジストリに登録されてシェル拡張が有効となります。。解除する場合にはinstall.exeに引数-Uを付けて実行してください(install.exe -U)。