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

Previous  Top  Next

    
 

 

Для подобных действий пишется маленький комсервер задача которого лишь реализовать 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