Как зарегистрировать свою команду в контекстном меню проводника?

=== Как зарегистрировать свою команду в контекстном меню проводника? ===
Для подобных действий пишется маленький COM-сервер задача которого лишь реализовать 2 интерфейса IShellExtInit и IContextMenu.
Для чего это делается - операционная система при инициализации меню проверит твою библиотеку на предмет: поддерживает ли она эти интерфейсы и если да - то вызовет нужные их методы. Ну а уж при срабатывании данных методов ты и добавляешь свои пункты меню. Для облегчения отладки, чтобы библиотека выгружалась сразу же как только не используется производим следующие действия:
В реестре вот по этому пути
 HKEY_LOCAL_MASHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer
устанавливаем строковое значение AlwaysUnloadDLL равным "1" (если такого значения нет, тогда нужно его создать). Далее пишем код:
вот реализация сервера:
// Test COM Server Shell Context menu extention
library CONTMENU;
uses
 ComServ,
 ContextM in 'ContextM.pas';
exports
 DllGetClassObject,
 DllCanUnloadNow,
 DllRegisterServer,
 DllUnregisterServer;
begin
end.
unit ContextM;
interface
uses
 Windows, ActiveX, ComObj, ShlObj;
type
 TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
 private
 FFileName: array[0..MAX_PATH] of Char;
 TmpFileNames:String;
 protected
 { IShellExtInit }
 function IShellExtInit.Initialize = SEIInitialize;
 function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
 hKeyProgID: HKEY): HResult; stdcall;
 { IContextMenu }
 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;
 end;
resourcestring
 IDC_TEST1 = 'Тестовая строка номер 1';
 IDC_TEST2 = 'Тестовая строка номер 2';
const
 Class_ContextMenu: TGUID = '{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}';
implementation
uses ComServ, SysUtils, ShellApi, Registry, Graphics;
// Тут наше меню инициализируется
// на вход приходит интерфейс IDataObject из которого мы можем получить
// список файлов и папок над которыми будут происходить действия
function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
 hKeyProgID: HKEY): HResult;
var
 StgMedium: TStgMedium;
 FormatEtc: TFormatEtc;
 FilesCount,I:Integer;
begin
 if (lpdobj = nil) then
 begin
 Result := E_INVALIDARG;
 Exit;
 end;
 with FormatEtc do begin
 cfFormat := CF_HDROP;
 ptd := nil;
 dwAspect := DVASPECT_CONTENT;
 lindex := -1;
 tymed := TYMED_HGLOBAL;
 end;
 Result := lpdobj.GetData(FormatEtc, StgMedium);
 if Failed(Result) then Exit;
 TmpFileNames := ;
 FilesCount := DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0);
 for I:= 0 to FilesCount - 1 do
 begin
 DragQueryFile(StgMedium.hGlobal, I, FFileName, SizeOf(FFileName));
 TmpFileNames := TmpFileNames + '"'+FFileName+'" ';
 end;
 Result := NOERROR;
 ReleaseStgMedium(StgMedium);
end;
// Создание меню
// по этому событию мы добавляем новые элементы меню...
function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
 idCmdLast, uFlags: UINT): HResult;
begin
 Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);
 if ((uFlags and $0000000F) = CMF_NORMAL) or
 ((uFlags and CMF_EXPLORE) <> 0) then
 begin
 // Разделитель
 InsertMenu(Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0, nil);
 // первый пункт меню
 InsertMenu(Menu, indexMenu + 1, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(IDC_TEST1));
 // второй пункт меню
 InsertMenu(Menu, indexMenu + 2, MF_STRING or MF_BYPOSITION, idCmdFirst + 1, PChar(IDC_TEST2));
 // разделитель
 InsertMenu(Menu, indexMenu + 3, MF_SEPARATOR or MF_BYPOSITION, 0, nil);
 // указываем сколько пунктов меню мы добавили
 // 2 пункта - т.к. разделители не считаются
 Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 2);
 end;
end;
// данная функция срабатывает при нажатии на наш элемент меню
function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
 Result := E_FAIL;
 if (HiWord(Integer(lpici.lpVerb)) <> 0) then Exit;
 Result := NOERROR;
 // Выбор элементов меню идет по возрастающей в том порядке
 // в каком они были добавлены
 case LoWord(lpici.lpVerb) of
 0: // первый элемент меню
 // тут собственно и нужно делать реакцию на нажатие ;)
 MessageBox(lpici.hWnd, PChar(TmpFileNames), PChar(IDC_TEST1 + ' Pressed'), MB_OK);
 1: // второй элемент меню
 MessageBox(lpici.hWnd, PChar(TmpFileNames), PChar(IDC_TEST2 + ' Pressed'), MB_OK);
 else
 Result := E_INVALIDARG;
 end;
end;
// Данная функция вызывается когда статус бар в эксплорере активен
// и в нем отображается краткая информация о подсвеченном пункте меню
function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
 pszName: LPSTR; cchMax: UINT): HRESULT;
begin
 Result := S_OK;
 if uType = GCS_HELPTEXT then
 case idCmd of
 0:
 begin
 StrCopy(pszName, 'Справочная информация по первому пункту меню');
 end;
 1:
 begin
 StrCopy(pszName, 'Справочная информация по второму пункту меню');
 end
 else
 Result := E_INVALIDARG
 end
end;
type
 TContextMenuFactory = class(TComObjectFactory)
 public
 procedure UpdateRegistry(Register: Boolean); override;
 end;
// Это процедура которая будет выполнятся при вызове библиотеки из командной строки
// regsvr32 C:\CONTMENU.dll - регистрация библиотеки
// regsvr32 C:\CONTMENU.dll -unregister - снятие библиотеки с регистрации
procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
 ClassID: string;
begin
 if Register then
 begin
 inherited UpdateRegistry(Register);
 ClassID := GUIDToString(Class_ContextMenu);
 CreateRegKey('Test\shellex', , );
 CreateRegKey('Test\shellex\ContextMenuHandlers', , );
 CreateRegKey('Test\shellex\ContextMenuHandlers\ContMenu', , ClassID);
 if (Win32Platform = VER_PLATFORM_WIN32_NT) then
 with TRegistry.Create do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
 OpenKey('Approved', True);
 WriteString(ClassID, 'Test Context Menu Shell Extension');
 finally
 Free;
 end;
 end
 else
 begin
 DeleteRegKey('Test\shellex\ContextMenuHandlers\ContMenu');
 DeleteRegKey('Test\shellex\ContextMenuHandlers');
 DeleteRegKey('Test\shellex');
 inherited UpdateRegistry(Register);
 end;
end;
initialization
 TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
 , 'Test Context Menu Shell Extension', ciMultiInstance,
 tmApartment);
end.
Вот и все, компилишь этот код и у тебя готовый COM сервер... Регистрировать библиотеку из своей программы так:
// Установка...
procedure TForm1.btnRegClick(Sender: TObject);
begin
 with TRegistry.Create do
 try
 RootKey := HKEY_CLASSES_ROOT;
 OpenKey('CLSID\{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}\InprocServer32', True);
 WriteString(,'C:\CONTMENU.dll');
 WriteString('ThreadingModel','Apartment');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('SOFTWARE\Classes\CLSID\{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}\InprocServer32', True);
 WriteString(,'C:\CONTMENU.dll');
 WriteString('ThreadingModel','Apartment');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);
 WriteString('{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}', 'Test Context Menu Shell Extension');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_CLASSES_ROOT;
 OpenKey('*\shellex\ContextMenuHandlers\Test', True);
 WriteString(,'{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_CLASSES_ROOT;
 OpenKey('Folder\shellex\ContextMenuHandlers\Test', True);
 WriteString(,'{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}');
 CloseKey;
 finally
 Free;
 end;
end;
а снимать с регистрации вот так:
// Удаление ...
procedure TForm1.btnUnRegClick(Sender: TObject);
begin
 with TRegistry.Create do
 try
 RootKey := HKEY_CLASSES_ROOT;
 OpenKey('CLSID', True);
 DeleteKey('{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('SOFTWARE\Classes\CLSID', True);
 DeleteKey('{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);
 DeleteValue('{45C15F61-ACAD-48C6-8D86-321ED8A6CFC6}');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_CLASSES_ROOT;
 OpenKey('*\shellex\ContextMenuHandlers', True);
 DeleteKey('Test');
 CloseKey;
 finally
 Free;
 end;
 with TRegistry.Create do
 try
 RootKey := HKEY_CLASSES_ROOT;
 OpenKey('Folder\shellex\ContextMenuHandlers', True);
 DeleteKey('Test');
 CloseKey;
 finally
 Free;
 end;
end;
Если нужно, чтобы пункты меню возникали только для определенных типов файлов, то при вызове QueryContextMenu нужно проверить какие файлы находятся в TmpFileNames, если данные типы файлов не подходят, то выходить из процедуры с результатом
Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);
Author: Автор: Rouse_
Source: Взято из http://forum.sources.ru
ID: 02391