VPF::Shell Extension - Форум программистов

Ne1tr1n0

Дата 25.8.2011, 17:12 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: нет
Всего: 8

Добрый вечер!

Встала задача написать расширение оболочки, добавляющее пункты в контекстное меню Explorer'a. Взял пример на лазарусе (ибо надо и 32-х 64-битное расширение), начал с ним шаманить, но что-то у меня сплошные неполадки. С одним пунктом меню всё работает замечательно, а вот когда пытаюсь добавить ещё один пункт - получается чушь. На файлах так и остается одно меню, на папках два, но почему-то они разрозненные, на XP вообще иконки плывут. Собсна что сделал:

Код


//добавил свойство для хранения второй картинки меню
    TGetExeInfoShellExt = class (TInterfacedObject, IShellExtInit, IContextMenu)
      private
        hBitmapAdd : THandle;
        hBitmapExt : THandle;
...

function TGetExeInfoShellExt.SEIInitialize (pidlFolder: PItemIDList;
                                            lpdobj: IDataObject;
                                            hKeyProgID: HKEY) : HResult;
...
//загружаем из ресурсов битмапы, в деструкторе освобождаем завнимаемую ими память
    if (hBitmapAdd = 0) then
        hBitmapAdd := LoadBitmap (hInstance, MakeIntResource (101));
    If (hBitmapExt = 0) then
        hBitmapExt := LoadBitmap (hInstance, MakeIntResource (102));
...
//получаем список файлов
    fNames:=TStringList.Create;

    for i:=0 to DragQueryFile (StgMedium.hGlobal, $FFFFFFFF, NIL, 0) - 1 do
    begin
        SetLength (FFileName, MAX_PATH);
        DragQueryFile (StgMedium.hGlobal, i, PChar (FFileName), MAX_PATH);
        SetLength (FFileName, lstrlen (PChar (FFileName)));
        fNames.Add(FFileName);
        Result := S_OK;
    end;

//далее в методе QueryContextMenu слегка модифицировал процедуру вставки пункта меню:
procedure CreateMenu (const sText: String; Ico: THandle);
...
//добавление собственно так идет:
    uMenuAdd := indexMenu;

    if ((uFlags and $0000000F) = CMF_NORMAL) or
       ((uFlags and CMF_EXPLORE) <> 0) then
    begin
        CreateMenu (cMenuAdd, hBitmapAdd);
        Inc(IndexMenu);
        Inc(IdCmdFirst);

        uMenuExt:=indexMenu;
        Createmenu (cMenuExt, hBitmapExt);
...
//в методах InvokeCommand и GetCommandString соотвественно проверяю lpici.lpVerb и idCmd и делаю что нужно в соответствии с ними.

Регистрация и разрегистрация выглядит так:

Код


function DllRegisterServer: HResult; stdcall;
var
  FileName: array [0..MAX_PATH] of Char;
begin
  try
    GetModuleFileName(HInstance, FileName, SizeOf(FileName));
    SetRegistryString(HKEY_CLASSES_ROOT, CLSID_Str, '', 'Sample Shell Extension');
    SetRegistryString(HKEY_CLASSES_ROOT, CLSID_Str + '\InProcServer32', '', FileName);
    SetRegistryString(HKEY_CLASSES_ROOT, CLSID_Str + '\InProcServer32', 'ThreadingModel', 'Apartment');
    SetRegistryString(HKEY_CLASSES_ROOT, '*\shellex\ContextMenuHandlers\' + CLSID_String, '', 'Sample Shell Extension');
    SetRegistryString(HKEY_CLASSES_ROOT, 'Folder\shellex\ContextMenuHandlers\' + CLSID_String, '', 'Sample Shell Extension');
    SetRegistryString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', CLSID_String, 'Sample Shell Extension');
    Result := S_OK
  except
    DllUnregisterServer;
    Result := $00040201;
  end
end;

function DllUnregisterServer: HResult; stdcall;
begin
  RegDeleteKey(HKEY_CLASSES_ROOT, CLSID_Str);
  RegDeleteKey(HKEY_CLASSES_ROOT, '*\shellex\ContextMenuHandlers\' + CLSID_String);
  RegDeleteKey(HKEY_CLASSES_ROOT, 'Folder\shellex\ContextMenuHandlers\' + CLSID_String);
  DeleteRegistryValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', CLSID_String);
  Result := S_OK
end;

В аттаче лежит собсна исходник. Подскажите пожалуйста, в чем я неправ, и направьте в нужную сторону, а то уже не знаю что делать...
Спасибо.

Это сообщение отредактировал(а) Ne1tr1n0 - 25.8.2011, 17:13

Присоединённый файл ( Кол-во скачиваний: 3 )

GetExeInfoU.pas 14,61 Kb

Keeper89

Дата 25.8.2011, 22:58 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: нет
Всего: 58

Подожди месяц и будешь писать на Delphi.

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

Ne1tr1n0

Дата 26.8.2011, 08:48 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: нет
Всего: 8

XE2 это конечно хорошо, 64 бита и много других вкусностей, но имхо лучше бы они с релизом не торопились, а баги правили. Да и месяц честно говоря довольно долго в моем случае.
Плюс ко всему сейчас попробовал скомпилить в семерке 32-битную дллку - те же помидоры. Поэтому пойду читать мсдн, курить примеры, ну и надеюсь на вашу помощь smile

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: ActiveX/СОМ/CORBA \| Следующая тема »