delphi - 循环通过 IContextMenu

Question

如何遍历 IContextMenu 的所有项目和子项目并列出所有可用动词？到目前为止，我从 JCL 中提取了这个工作代码：

function DisplayContextMenuPidl(const Handle: THandle; const Folder: IShellFolder; Item: PItemIdList; Pos: TPoint): Boolean;
var
  Cmd: Cardinal;
  ContextMenu: IContextMenu;
  ContextMenu2: IContextMenu2;
  Menu: HMENU;
  CommandInfo: TCMInvokeCommandInfo;
  CallbackWindow: THandle;
  vteste : string;
begin
  Result := False;
  if (Item = nil) or (Folder = nil) then
    Exit;
  Folder.GetUIObjectOf(Handle, 1, Item, IID_IContextMenu, nil,
    Pointer(ContextMenu));
  if ContextMenu <> nil then
  begin
    Menu := CreatePopupMenu;
    if Menu <> 0 then
    begin
      if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then
      begin
        CallbackWindow := 0;
        if Succeeded(ContextMenu.QueryInterface(IContextMenu2, ContextMenu2)) then
        begin
          CallbackWindow := CreateMenuCallbackWnd(ContextMenu2);
        end;
        ClientToScreen(Handle, Pos);
        Cmd := Cardinal(TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, Pos.X, Pos.Y, 0, CallbackWindow, nil));
        if Cmd <> 0 then
        begin
          ResetMemory(CommandInfo, SizeOf(CommandInfo));
          CommandInfo.cbSize := SizeOf(TCMInvokeCommandInfo);
          CommandInfo.hwnd := Handle;
          CommandInfo.lpVerb := MakeIntResourceA(Cmd - 1);
          CommandInfo.nShow := SW_SHOWNORMAL;
          Result := Succeeded(ContextMenu.InvokeCommand(CommandInfo));
        end;
        if CallbackWindow <> 0 then
          DestroyWindow(CallbackWindow);
      end;
      DestroyMenu(Menu);
    end;
  end;
end;

此代码工作正常，它显示上下文菜单。我需要对其进行调整，以便它可以列出（可能是日志文件）所有菜单和子菜单动词。

编辑

为了澄清让我们假设我有这个上下文菜单：

在此处输入图像描述

我想记录这样的事情：

项目动词

打开=打开
属性=属性
发送到=
发送到发送到蓝牙=xxx

编辑

如果有人有另一种获取动词或通过显示文本调用项目的方法，我也将不胜感激。

score 5 · Accepted Answer

要枚举上下文菜单的项目，您可以使用 Windows Menu functions：GetMenuItemCount、GetMenuItemInfo、GetSubMenu。

使用这些函数我写了这个函数

uses
JclShell,
ShlObj;

function DisplayContextMenuInfo( const Folder: IShellFolder; Item: PItemIdList; List :TStrings): Boolean;

  function GetMenuItemCaption(const hSubMenu: HMENU; const MenuId: Integer): string;
  var
    MenuItemInfo: TMenuItemInfo;
  begin
    MenuItemInfo.cbSize := SizeOf(MenuItemInfo);
    MenuItemInfo.fMask := MIIM_STRING;
    SetLength(Result, 1024*Sizeof(Char));
    MenuItemInfo.dwTypeData := PChar(Result);
    MenuItemInfo.cch        := Length(Result)-1;
    if not GetMenuItemInfo(hSubMenu, MenuId, False, MenuItemInfo) then
      RaiseLastOSError;
    SetLength(Result, MenuItemInfo.cch*Sizeof(Char));
  end;

  Procedure LogGetMenuInfo(Menu: HMENU);
  var
    i             : Integer;
    ItemsCount    : Integer;
    MenuId        : Cardinal;
    Caption       : string;
  begin
     ItemsCount:=GetMenuItemCount(Menu);

     List.Add(Format('Number of items %d ',[ItemsCount]));
      for i:= 0 to ItemsCount - 1 do
      begin
        MenuId:=GetMenuItemID(Menu,i);

        case MenuId of

         Cardinal(-1) : begin
                          List.Add('');
                          List.Add(Format('Sub Menu',[]));
                          LogGetMenuInfo(GetSubMenu(Menu,i));
                        end;
         0            :

         else
                        begin
                          Caption:=GetMenuItemCaption(Menu, MenuId);
                          List.Add(Format('MenuId (Cmd) %d Caption %s  ',[MenuId,Caption]))
                        end;

        end;
      end;

  end;


var
  ContextMenu: IContextMenu;
  Menu: HMENU;

begin
  Result := False;
  if (Item = nil) or (Folder = nil) then  Exit;
  Folder.GetUIObjectOf(0, 1, Item, IID_IContextMenu, nil,  Pointer(ContextMenu));
  if ContextMenu <> nil then
  begin
    Menu := CreatePopupMenu;
    try
      if Menu <> 0 then
        if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then
           LogGetMenuInfo(Menu);
    finally
      DestroyMenu(Menu);
    end;
  end;
end;

并以这种方式调用

var
  ItemIdList: PItemIdList;
  Folder    : IShellFolder;
  FileName  : string;
begin
  FileName:= 'C:\Users\Dexter\Downloads\VirtualTreeview.pdf';
  ItemIdList := PathToPidlBind(FileName, Folder);
  if ItemIdList <> nil then
  begin
    DisplayContextMenuInfo( Folder, ItemIdList, Memo1.lines);
    PidlFree(ItemIdList);
  end;
end;

这将使用如下信息填充作为参数传递的 TStrings：

Number of items 26 
MenuId (Cmd) 141 Caption Open with Adobe Reader X
MenuId (Cmd) 142 Caption &Open
MenuId (Cmd) 143 Caption &Print
MenuId (Cmd) 146 Caption Run &Sandboxed
MenuId (Cmd) 140 Caption Analizar con &AVG
Sub Menu
Number of items 28 
MenuId (Cmd) 105 Caption Add To Send To
MenuId (Cmd) 106 Caption Add To Templates
MenuId (Cmd) 107 Caption Change Date && Time
MenuId (Cmd) 108 Caption Change Extension: pdf
MenuId (Cmd) 109 Caption Choose Program
MenuId (Cmd) 110 Caption Command Prompt
MenuId (Cmd) 111 Caption Copy/Move To Folder
MenuId (Cmd) 112 Caption Copy Path
MenuId (Cmd) 113 Caption Delete On Reboot
MenuId (Cmd) 114 Caption Duplicate File
MenuId (Cmd) 115 Caption Encrypt File
MenuId (Cmd) 116 Caption Explore Rooted
MenuId (Cmd) 117 Caption Extended Delete
MenuId (Cmd) 118 Caption Extended Search && Replace

现在使用这个函数，你可以传递你想要执行的 menuid (cmd)

function InvokeContextMenuCommand(const Comnand: Cardinal; const Folder: IShellFolder; Item: PItemIdList): Boolean;
var
  ContextMenu   : IContextMenu;
  CommandInfo   : TCMInvokeCommandInfo;
  Menu          : HMENU;
  CallbackWindow: THandle;
begin
  Result := False;
  if Comnand=0 then exit;

  if (Item = nil) or (Folder = nil) then  Exit;
    Folder.GetUIObjectOf(0, 1, Item, IID_IContextMenu, nil,  Pointer(ContextMenu));
  if ContextMenu <> nil then
   begin
    Menu := CreatePopupMenu;
    try
      if Menu <> 0 then
      if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then
      begin
        CallbackWindow:=0;
        TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or  TPM_RIGHTBUTTON or TPM_RETURNCMD, 0, 0, 0, CallbackWindow, nil);
        ZeroMemory(@CommandInfo, SizeOf(CommandInfo));
        CommandInfo.cbSize := SizeOf(TCMInvokeCommandInfo);
        CommandInfo.hwnd   := 0;
        CommandInfo.lpVerb := MakeIntResourceA(Comnand - 1);
        CommandInfo.nShow  := SW_SHOWNORMAL;
        Result := Succeeded(ContextMenu.InvokeCommand(CommandInfo));
      end;
    finally
     DestroyMenu(Menu);
    end;
   end;
end;

以这种方式调用

var
  ItemIdList: PItemIdList;
  Folder    : IShellFolder;
  FileName  : string;
begin
  FileName:= 'C:\Users\Dexter\Downloads\VirtualTreeview.pdf';
  ItemIdList := PathToPidlBind(FileName, Folder);
  if ItemIdList <> nil then
  begin
    //calling the 141 Menuid = `Open with Adobe Reader X`
    InvokeContextMenuCommand(141,Folder, ItemIdList);
    PidlFree(ItemIdList);
  end;
end;

score 2 · Accepted Answer

在您致电后，QueryContextMenu您的菜单将大部分被填充。您知道菜单的句柄，因此可以迭代其项目并获取您需要的信息。

function DisplayContextMenuPidl(const Handle: THandle; const Folder: IShellFolder; Item: PItemIdList; Pos: TPoint): Boolean;

//++
  procedure RecurseItems(const Menu: HMENU; Strings: TStrings; Indent: Integer = 0);

    function GetItemString(Parent: HMENU; Item: Integer): string;
    begin
      SetLength(Result, GetMenuString(Parent, Item, nil, 0, MF_BYPOSITION) + 1);
      GetMenuString(Parent, Item, PChar(Result), Length(Result), MF_BYPOSITION);
    end;

  var
    i: Integer;
    ItemInfo: TMenuItemInfo;
  begin
    for i := 0 to GetMenuItemCount(Menu) - 1 do begin
      FillChar(ItemInfo, SizeOf(ItemInfo), 0);
      ItemInfo.cbSize := SizeOf(ItemInfo);
      ItemInfo.fMask := MIIM_SUBMENU or MIIM_TYPE;
      GetMenuItemInfo(Menu, i, True, ItemInfo);
      if ItemInfo.fType <> MFT_SEPARATOR then
        Strings.Add(StringOfChar('-', Indent * 2) + GetItemString(Menu, i));
      if ItemInfo.hSubMenu <> 0 then
        RecurseItems(ItemInfo.hSubMenu, Strings, Indent + 1);
    end;
  end;
//--

var
  Cmd: Cardinal;
  ContextMenu: IContextMenu;
  ContextMenu2: IContextMenu2;
  ...

  begin
    Menu := CreatePopupMenu;
    if Menu <> 0 then
    begin
      if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then

//++
      Memo1.Clear;
      RecurseItems(Menu, Memo1.Lines);
//--

      begin
        CallbackWindow := 0;
      ..

如果在检索“IContextMenu2”界面后获取项目文本并没有任何区别，因为在选择父菜单项之前不会填充“发送到”或“新建”等子菜单。在该例程中，您无法访问它们。请注意以下在上述代码的示例输出中未能展开的两项：

＆打开
以管理员身份运行
解决兼容性
7-Zip
--打开存档
- 提取文件...
--提取这里
--测试存档
- 添加到档案...
与某人分享
--
固定到任务栏(&K)
固定到开始菜单(&U)
还原以前的版本
发送至
--
切
＆复制
创建快捷方式(&S)
＆删除
特性

显示子项的消息将通过 CallbackWindow 的 WndProc，如 WM_INITMENUPOPUP、WM_ENTERIDLE、WM_MEASUREITEM、WM_DRAWITEM。但我认为尝试提取那里的信息根本没有任何意义..

delphi - 循环通过 IContextMenu

项目 动词

2 回答 2

Related

Reference

项目动词