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

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

Для подобных действий пишется маленький комсервер задача которого лишь реализовать 2 интерфейса IShellExtInit и IContextMenu. Для чего это делается - операционная система при инициализации меню проверит твою библиотеку на предмет: поддерживает ли она эти интерфейсы и если да - то вызовет нужные их методы. Ну а уж при срабатывании данных методов ты и добавляешь свои пункты меню. Для облегчения отладки, чтобы библиотека выгружалась сразу же как только не используется производим следующие действия: В реестре вот по этому пути HKEY_LOCAL_MASHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer устанавливаем строковое значение AlwaysUnloadDLL равным "1" (если такого значения нет, тогда нужно его создать). Далее пишем код: вот реализация сервера:

Code: // Test COM Server Shell Context menu extention. Library CONTMENU; {©Drkb v.3(2007): www.drkb.ru}. Uses. ComServ, ContextM in 'ContextM.pas'; Exports. DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer; Begin. End.

Code: Unit ContextM; {©Drkb v.3(2007): www.drkb.ru}. 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.

Вот и все, компилишь этот код и у тебя готовый ком сервер... Регистрировать билиотеку из своей программы так:

Code: // Установка... {©Drkb v.3(2007): www.drkb.ru}. 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, если данные типы файлов не подходят, то выходить из процедуры с результатом

Code: Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);

Взято из http://forum.sources.ru.

Автор: Rouse_

©Drkb::02391.