| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Подскажите как добавить свой пункт в контекстное меню Explorer-a [D6, Win95/98, WinME, Win2k, WinXP]

FireMan_Alexey ©   (2005-12-29 16:09:00) 

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

---

FireMan_Alexey   (2005-12-30 13:11:00) [1]

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

---

Leonid Troyanovsky   (2005-12-29 19:07:00) [2]

> FireMan_Alexey ©   (29.12.05 16:09)  


demos\activex\shellext\contmenu.dpr

--
Regards, LVT.

---

Poirot   (2005-12-29 17:56:00) [3]

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

---

Rouse_   (2005-12-29 17:27:00) [4]

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.

---

Наверх