等待进程由 IContextMenu.InvokeCommand 启动

Question

我有一个 TListView，其项目是文件，用户可以通过双击打开这些文件。

为此，我将文件保存在 windows 临时文件夹中，启动一个线程，用 ShellExecuteEx() 打开保存的文件，让它等待 ShellExecuteInfo.hProcess，就像这个：

TNotifyThread = class(TThread)
private
  FFileName: string;
  FFileAge: TDateTime;
public
  constructor Create(const FileName: string; OnClosed: TNotifyEvent); overload;
  procedure Execute; override;

  property FileName: String read FFileName;
  property FileAge: TDateTime read FFileAge;
end;

{...}

constructor TNotifyThread.Create(const FileName: string; OnClosed: TNotifyEvent);
begin
  inherited Create(True);
  if FileExists(FileName) then
    FileAge(FileName, FFileAge);

  FreeOnTerminate := True;
  OnTerminate := OnClosed;
  FFileName := FileName;

  Resume;
end;

procedure TNotifyThread.Execute;
var
  se: SHELLEXECUTEINFO;
  ok: boolean;
begin
  with se do
  begin
    cbSize := SizeOf(SHELLEXECUTEINFO);
    fMask := SEE_MASK_INVOKEIDLIST or SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOASYNC;
    lpVerb := PChar('open');
    lpFile := PChar(FFileName);
    lpParameters := nil;
    lpDirectory := PChar(ExtractFilePath(ParamStr(0)));
    nShow := SW_SHOW;
  end;

  if ShellExecuteEx(@se) then
  begin
    WaitForSingleObject(se.hProcess, INFINITE);
    if se.hProcess <> 0 then
      CloseHandle(se.hProcess);
  end;
end;

这样，我可以使用 TThread.OnTerminate 事件写回用户关闭文件后对文件所做的任何更改。

我现在在 JclShell.DisplayContextMenu()（使用 IContextMenu）的帮助下显示 windows 上下文菜单。

我的目标：等待在上下文菜单中选择的执行的操作（例如 'properties'、'delete'、..）完成（或得到任何形式的通知）时尚），这样我就可以检查临时文件是否有更改以将其写回，或者在删除的情况下删除 TListItem。

由于 CMINVOKECOMMANDINFO 不像 SHELLEXECUTEINFO 那样 return 进程句柄，所以我无法以相同的方式进行处理。

将 MakeIntResource(commandId-1) 分配给 SHELLEXECUTEINFO.lpVerb 导致对 ShellExecuteEx() 的调用崩溃并出现 EAccessViolation。 SHELLEXECUTEINFO.

似乎不支持此方法

我试图从 IContextMenu.GetCommandString() 获取命令字符串和来自 TrackPopupMenu() 的命令 ID，以便稍后将其传递给 SHELLEXECUTEINFO.lpVerb，但 GetCommandString() 不会 return 已单击某些项目的命令。

工作菜单项：

properties, edit, copy, cut, print, 7z: add to archive (verb is 'SevenZipCompress', wont return processHandle), KapserskyScan (verb is 'KL_scan', wont return processHandle)

不工作：

anything within "open with" or "send to"

这仅仅是 IContextMenu 实现的错误吗？

可能跟我使用AnsiStrings有关？不过，我无法让 GCS_VERBW 工作。有没有比这更好的方法来可靠地获得 CommandString？

function CustomDisplayContextMenuPidlWithoutExecute(const Handle: THandle; 
const Folder: IShellFolder;
  Item: PItemIdList; Pos: TPoint): String;
var
  ContextMenu: IContextMenu;
  ContextMenu2: IContextMenu2;
  Menu: HMENU;
  CallbackWindow: THandle;
  LResult: AnsiString;
  Cmd: Cardinal;
begin
  Result := '';
  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, FFF, 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
          SetLength(LResult, MAX_PATH);
          cmd := ContextMenu.GetCommandString(Cmd-1, GCS_VERBA, nil, LPSTR(LResult), MAX_PATH);
          Result := String(LResult);
        end;
        if CallbackWindow <> 0 then
          DestroyWindow(CallbackWindow);
      end;
      DestroyMenu(Menu);
    end;
  end;
end;

我在 How to host an IContextMenu, as well as researched on MSDN (for example CMINVOKECOMMANDINFO, GetCommandString(), SHELLEXECUTEINFO and TrackPopupMenu()) 上阅读了 Raymond Chen 的博客，但我可能遗漏了一些微不足道的东西。

Answer 1

我最终使用 TJvChangeNotify 监控 windows 临时文件夹，同时将监控文件保存在 TDictionary<FileName:String, LastWrite: TDateTime>.

中

因此每当 TJvChangeNotify 触发 OnChangeNotify 事件时，我可以检查我的哪些受监视文件已被删除（通过检查是否存在）或已更改（通过比较上次写入时间）。

示例ChangeNotifyEvent：

procedure TFileChangeMonitor.ChangeNotifyEvent(Sender: TObject; Dir: string;
  Actions: TJvChangeActions);
var
  LFile: TPair<String, TDateTime>;
  LSearchRec: TSearchRec;
  LFoundErrorCode: Integer;
begin
  for LFile in FMonitoredFiles do
  begin
    LFoundErrorCode := FindFirst(LFile.Key, faAnyFile, LSearchRec);
    try
      if LFoundErrorCode = NOERROR then
      begin
        if LSearchRec.TimeStamp > LFile.Value then
        begin
          // do something with the changed file
          {...}

          // update last write time
          FMonitoredFiles.AddOrSetValue(LFile.Key, LSearchRec.TimeStamp);
        end;
      end // 
      else if (LFoundErrorCode = ERROR_FILE_NOT_FOUND) then
      begin
        // do something with the deleted file
        {...}

        // stop monitoring the deleted file
        FMonitoredFiles.Remove(LFile.Key);
      end;
    finally
      System.SysUtils.FindClose(LSearchRec);
    end;
  end;
end;

等待进程由 IContextMenu.InvokeCommand 启动

Wait for process started by IContextMenu.InvokeCommand

windows

delphi

winapi

delphi-10.2-tokyo