Подскажите как добавить свой пункт в контекстное меню Explorer-a

← →
FireMan_Alexey © (2005-12-29 16:09) [0]

Всех с наступающим Новым годом!
Подскажите как добавить свой пункт в контекстное меню Explorer-a, как это делает Winrar или Антивирус?
Если можно ссылочку с примером :)
Заранее благодарен!!!!

← →
Rouse_ © (2005-12-29 17:27) [1]

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}"; //var Params: String; 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.

← →
Poirot © (2005-12-29 17:56) [2]

А елси точнее и весь процесс то иди сюда :) http://www.rsdn.ru/summary/389.xml

← →
Leonid Troyanovsky © (2005-12-29 19:07) [3]

Всем спасибо!
Буду разгребать! :)

Подскажите как добавить свой пункт в контекстное меню Explorer-a Найти похожие ветки