Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Добавление пункта в контекстное меню  (Прочитано 19323 раз)
0 Пользователей и 1 Гость смотрят эту тему.
MS
Помогающий

ru
Offline Offline
Пол: Мужской

« : 12-07-2007 09:35 » 

Подскажите как добавить в контекстное меню проводника пункт для запуска своего приложения.
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


WWW
« Ответ #1 : 12-07-2007 09:39 » 

MS, вопрос неясен )  Может ты имеешь в виду меню Пуск ? Уточни...

потому что из контекстного меню проводника обычно вызываются инструменты (хотя, в принципе, это тоже ведь программы )

в любом случае - надо копаться в реестре.
Записан

MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #2 : 12-07-2007 09:51 » 

Алексей1153++, нужно чтобы привыделении файлов и клике на правую клавишу мыши в контекстном меню отображался пункт при щелчке на котором запускалась моя прога и в listbox добавлялись пути к выделенным файлам. Вот Улыбаюсь
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #3 : 12-07-2007 14:11 » 

Этот вопрос решается через шелл. Набери в поисковике слово ShellExt и думаю, найдешь готовый пример.
Записан
MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #4 : 13-07-2007 06:05 » 

нашел стандартный пример в Delphi.
Непонятна одна строка. Что она значит

Result := ExpandFileName(ReadString('RootDir') + '\bin\dcc32.exe');
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


WWW
« Ответ #5 : 13-07-2007 06:29 » 

MS, всё решение в студию Улыбаюсь  Нам же тоже интересно
Записан

zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #6 : 13-07-2007 06:48 » 

Ms, это определение полного пути к файлу-компилятору Delphi (работающему из командной строки). Дело в том, что в этом примере из созданного пункта контекстного меню должен вызываться компилятор Delphi, который скомпилирует выделенный файл (естественно если это файл проекта Delphi).
Алексей1153++, вот код примера:
Код:
unit ContextM;

interface

uses
  Windows, ActiveX, ComObj, ShlObj, Dialogs;

type
  TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  private
    FFileName: array[0..MAX_PATH] of Char;
  protected
    { IShellExtInit }
    function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
    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;

const
  Class_ContextMenu: TGUID = '{EBDF1F20-C829-11D1-8233-0020AF3E97A9}';

implementation

uses ComServ, SysUtils, ShellApi, Registry;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
begin
  // Fail the call if lpdobj is Nil.
  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;

  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result := lpdobj.GetData(FormatEtc, StgMedium);
  if Failed(Result) then
    Exit;
  // If only one file is selected, retrieve the file name and store it in
  // FFileName. Otherwise fail the call.
  if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
    DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName));
    Result := NOERROR;
  end
  else begin
    FFileName[0] := #0;
    Result := E_FAIL;
  end;
  ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
begin
  Result := 0; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);

  if ((uFlags and $0000000F) = CMF_NORMAL) or
     ((uFlags and CMF_EXPLORE) <> 0) then begin
    // Add one menu item to context menu
    InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
      'Compile...');

    // Return number of menu items added
    Result := 1; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 1)
  end;
end;

function GetCompilerPath: string;
// Returns string containing path to Delphi command line compiler
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do begin
      RootKey := HKEY_LOCAL_MACHINE;

      OpenKey('\SOFTWARE\Borland\Delphi\6.0', False);
      Result := ExpandFileName(ReadString('RootDir') + '\bin\dcc32.exe');
    end;
    if AnsiPos(' ', Result) <> 0 then
      Result := ExtractShortPathName(Result);
    Result := Result + ' "%s"';
  finally
    Reg.Free;
  end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
resourcestring
  sPathError = 'Error setting current directory';

var
  H: THandle;
  PrevDir: string;
 
begin
  Result := E_FAIL;
  // Make sure we are not being called by an application
  if (HiWord(Integer(lpici.lpVerb)) <> 0) then
  begin
    Exit;
  end;

  // Make sure we aren't being passed an invalid argument number
  if (LoWord(lpici.lpVerb) <> 0) then begin
    Result := E_INVALIDARG;
    Exit;
  end;

  // Execute the command specified by lpici.lpVerb
  // by invoking the Delphi command line compiler.
  PrevDir := GetCurrentDir;
  try
    if not SetCurrentDir(ExtractFilePath(FFileName)) then
      raise Exception.CreateRes(@sPathError);

    H := WinExec(PChar(Format(GetCompilerPath, [FFileName])), lpici.nShow);

    if (H < 32) then
      MessageBox(lpici.hWnd, 'Error executing Delphi compiler.', 'Error',
        MB_ICONERROR or MB_OK);
    Result := NOERROR;
  finally
    SetCurrentDir(PrevDir);
  end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  if (idCmd = 0) then begin
    if (uType = GCS_HELPTEXT) then
      // return help string for menu item
      StrCopy(pszName, 'Compile the selected Delphi project');
    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;
end;

type
  TContextMenuFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_ContextMenu);
    CreateRegKey('DelphiProject\shellex', '', '');
    CreateRegKey('DelphiProject\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('DelphiProject\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, 'Delphi Context Menu Shell Extension Example');
        finally
          Free;
        end;
  end
  else begin
    DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers\ContMenu');
    DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers');
    DeleteRegKey('DelphiProject\shellex');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
    '', 'Delphi Context Menu Shell Extension Example', ciMultiInstance,
    tmApartment);
end.
Записан
MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #7 : 13-07-2007 07:29 » new

zubr, откомпилировал проект, с dllкой что делать?
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #8 : 13-07-2007 08:20 » 

Надо зарегистрировать сом-сервер. Для этого:
1. Создай батник с текстом: regsvr32.exe Твоя.dll
2. Сохрани его в каталог, где лежит твоя dll.
3. Запусти его.
Если все правильно, в проводнике должен появиться новый пункт в контекстном меню.
Записан
MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #9 : 13-07-2007 08:51 » 

Все успешно компилируется, но пункт не появляется.Вот код. Исправьте пожалуйста что не так.

Код:
unit ContextM;

interface

uses
  Windows, ActiveX, ComObj, ShlObj, Dialogs;

type
  TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  private
    FFileName: array[0..MAX_PATH] of Char;
  protected
    { IShellExtInit }
    function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
    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;

const
  Class_ContextMenu: TGUID = '{EBDF1F20-C829-11D1-8233-0020AF3E97A9}';

implementation

uses ComServ, SysUtils, ShellApi, Registry;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
begin
  // Fail the call if lpdobj is Nil.
  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;

  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result := lpdobj.GetData(FormatEtc, StgMedium);
  if Failed(Result) then
    Exit;
  // If only one file is selected, retrieve the file name and store it in
  // FFileName. Otherwise fail the call.
  if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
    DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName));
    Result := NOERROR;
  end
  else begin
    FFileName[0] := #0;
    Result := E_FAIL;
  end;
  ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
begin
  Result := 0; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);

  if ((uFlags and $0000000F) = CMF_NORMAL) or
     ((uFlags and CMF_EXPLORE) <> 0) then begin
    // Add one menu item to context menu
    InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
      'Добавить в Renamer');

    // Return number of menu items added
    Result := 1; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 1)
  end;
end;

function GetCompilerPath: string;
// Returns string containing path to Delphi command line compiler
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do begin
      RootKey := HKEY_LOCAL_MACHINE;

      OpenKey('\SOFTWARE\Renamer\1.0', False);
      Result := ExpandFileName(ReadString('RootDir') + '\bin\dcc32.exe');
    end;
    if AnsiPos(' ', Result) <> 0 then
      Result := ExtractShortPathName(Result);
    Result := Result + ' "%s"';
  finally
    Reg.Free;
  end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
resourcestring
  sPathError = 'Error setting current directory';

var
  H: THandle;
  PrevDir: string;

begin
  Result := E_FAIL;
  // Make sure we are not being called by an application
  if (HiWord(Integer(lpici.lpVerb)) <> 0) then
  begin
    Exit;
  end;

  // Make sure we aren't being passed an invalid argument number
  if (LoWord(lpici.lpVerb) <> 0) then begin
    Result := E_INVALIDARG;
    Exit;
  end;

  // Execute the command specified by lpici.lpVerb
  // by invoking the Delphi command line compiler.
  PrevDir := GetCurrentDir;
  try
    if not SetCurrentDir(ExtractFilePath(FFileName)) then
      raise Exception.CreateRes(@sPathError);

    H := WinExec(PChar(Format(GetCompilerPath, [FFileName])), lpici.nShow);

    if (H < 32) then
      MessageBox(lpici.hWnd, 'Ошибка загрузки программы Renamer', 'Error',
        MB_ICONERROR or MB_OK);
    Result := NOERROR;
  finally
    SetCurrentDir(PrevDir);
  end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  if (idCmd = 0) then begin
    if (uType = GCS_HELPTEXT) then
      // return help string for menu item
      StrCopy(pszName, 'Переименовать с помощью Renamer');
    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;
end;

type
  TContextMenuFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_ContextMenu);
    CreateRegKey('Renamer\shellex', '', '');
    CreateRegKey('Renamer\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('Renamer\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, 'Renamer');
        finally
          Free;
        end;
  end
  else begin
    DeleteRegKey('Renamer\shellex\ContextMenuHandlers\ContMenu');
    DeleteRegKey('Renamer\shellex\ContextMenuHandlers');
    DeleteRegKey('Renamer\shellex');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
    '', 'Renamer', ciMultiInstance,
    tmApartment);
end.

Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


WWW
« Ответ #10 : 13-07-2007 09:40 » 

MS, ребутнуть для начала надоть
Записан

MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #11 : 13-07-2007 11:36 » 

Алексей1153++, бестолку Жаль
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #12 : 13-07-2007 14:33 » 

Надо твой Renamer связать с определенным типом файлов:
Код:
procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_ContextMenu);
    CreateRegKey('.mytip', '', 'Renamer');//связываем
    CreateRegKey('Renamer\shellex', '', '');
    CreateRegKey('Renamer\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('Renamer\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, 'Renamer');
        finally
          Free;
        end;
  end
  else begin
    DeleteRegKey('.mytip');
    DeleteRegKey('Renamer\shellex\ContextMenuHandlers\ContMenu');
    DeleteRegKey('Renamer\shellex\ContextMenuHandlers');
    DeleteRegKey('Renamer\shellex');

    inherited UpdateRegistry(Register);
  end;
end;
Записан
MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #13 : 14-07-2007 06:21 » 

zubr, спасибо разобрался. Осталось только одно.
Подскажи как добавить выделенные файлы в listbox на форме
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #14 : 14-07-2007 19:04 » 

Так а в чем проблема, в переменной FFileName и будет полное имя выделенного файла.
Записан
MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #15 : 15-07-2007 06:29 » 

zubr, тут вообще все очень странно. Когда я задаю типы файлов * или .*, dll не срабатывает, т.е. в реестре есть а в контекстном меню нет и удалить ее можно. Когда же задаю какой-либо определенный тип файла например .jpg, все отлично. Что делать? Неужели предется ко всем расширениям отдельно прописывать?
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #16 : 15-07-2007 11:01 » 

Придется. Скорее всего это надо сделать программно, то есть программно просканировать реестр на типы файлов и для всех обнаруженных создать свои ключи.
Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines