Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: ActiveX/СОМ/CORBA > Shell Extension


Автор: Ne1tr1n0 25.8.2011, 17:12
Добрый вечер!

Встала задача написать расширение оболочки, добавляющее пункты в контекстное меню Explorer'a.  Взял http://cc.embarcadero.com/Item/27554 (ибо надо и 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;

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

Автор: Keeper89 25.8.2011, 22:58
Подожди месяц и будешь писать на Delphi.

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

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)