Delphi：如何以提升的身份启动应用程序并等待其终止？

Question

我正试图从我的程序中以提升的权限启动另一个应用程序，并等待其终止后才能继续。

我尝试了几种不同的解决方案，但没有找到完全正确的方法。

下面的代码是最接近正确的代码。它以提升的特权运行应用程序并等待其终止，但一旦外部应用程序终止，它就会冻结。换句话说，在启动的应用程序关闭后，它将不再继续处理。

我该如何实现我的目标？

procedure TfMain.RunFileAsAdminWait(hWnd: HWND; aFile, aParameters: string);
var
  sei: TShellExecuteInfo;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.Wnd := hWnd;
  sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
  sei.lpVerb := 'runas';
  sei.lpFile := PChar(aFile);
  sei.lpParameters := PChar(aParameters);
  sei.nShow := SW_SHOWNORMAL;

  if not ShellExecuteEx(@sei) then
    RaiseLastOSError
  else
    while WaitForSingleObject(sei.hProcess, 50) <> WAIT_OBJECT_0 do
      Application.ProcessMessages;

  CloseHandle(sei.hProcess);
end;

更新：

我想出了以下函数，但仅在调用它后有一个ShowMessage语句时才有效。 因此，我必须包含：

RunFileAsAdminWait(Handle, ExtractFilePath(Application.Exename) + 'AutoUpdate.exe', '/auto');
ShowMessage('test');

为了使函数起作用。我如何在不调用ShowMessage的情况下使它正常工作？

这是更新后的函数：

procedure TfMain.RunFileAsAdminWait(hWnd: HWND; aFile, aParameters: string);
var
  sei: TShellExecuteInfo;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.Wnd := hWnd;
  sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
  sei.lpVerb := 'runas';
  sei.lpFile := PChar(aFile);
  sei.lpParameters := PChar(aParameters);
  sei.nShow := SW_SHOWNORMAL;

  if not ShellExecuteEx(@sei) then
    RaiseLastOSError
  else
    if sei.hProcess <> 0 then
      WaitForSingleObject(sei.hProcess, 50)
    else
      Exit;

  CloseHandle(sei.hProcess);
end;

- croceldon

Answer 1

以下代码对我有效：

procedure RunFileAsAdminWait(hWnd: HWND; aFile, aParameters: string);
var
  sei: TShellExecuteInfo;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.Wnd := hWnd;
  sei.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS;
  sei.lpVerb := 'runas';
  sei.lpFile := PChar(aFile);
  sei.lpParameters := PChar(aParameters);
  sei.nShow := SW_SHOWNORMAL;

  if not ShellExecuteEx(@sei) then
    RaiseLastOSError;
  if sei.hProcess <> 0 then begin
    while WaitForSingleObject(sei.hProcess, 50) = WAIT_TIMEOUT do
      Application.ProcessMessages;
    CloseHandle(sei.hProcess);
  end;
end;

要获取进程句柄并等待进程完成，必须传递SEE_MASK_NOCLOSEPROCESS标志。我还更改了代码，使其在WaitForSingleObject()返回超时时循环。

有关标志的更多信息，请参阅SHELLEXECUTEINFO结构的MSDN页面。

- mghie

---

使用MsgWaitForMultipleObjects()比使用WaitForSingleObject()更有效率，这样你就可以在它告诉你有消息等待处理时才调用Application.ProcessMessages()。不要盲目地无谓地调用ProcessMessages()。 - Remy Lebeau

Answer 2

@mghie的答案通常是正确的，但在等待进程句柄时处理消息的代码可能存在问题。可以尝试使用以下代码改进：

procedure RunFileAsAdminWait(hWnd: HWND; aFile, aParameters: string);
var
  sei: TShellExecuteInfo;
  Ret: DWORD;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.Wnd := hWnd;
  sei.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS;
  sei.lpVerb := 'runas';
  sei.lpFile := PChar(aFile);
  sei.lpParameters := PChar(aParameters);
  sei.nShow := SW_SHOWNORMAL;

  if not ShellExecuteEx(@sei) then
    RaiseLastOSError;
  if sei.hProcess <> 0 then
  try
    repeat
      Ret := MsgWaitForMultipleObjects(1, sei.hProcess, False, INFINITE, QS_ALLINPUT);
      if Ret = (WAIT_OBJECT_0+1) then Application.ProcessMessages
      else if Ret = WAIT_FAILED then RaiseLastOSError;
    until Ret = WAIT_OBJECT_0;
  finally
    CloseHandle(sei.hProcess);
  end;
end;

- Remy Lebeau

---

感谢您撰写这篇详细的答案，Remy。 - Steve F

Answer 3

您的等待时间（50毫秒太短了），请尝试

WaitForSingleObject(sei.hProcess, INFINITE)

可以省略对有效进程句柄的检查（sei.hProcess <> 0）。

更正后的答案：

  while MsgWaitForMultipleObjects(1, sei.hProcess, False, INFINITE, QS_ALLINPUT)
    <> WAIT_OBJECT_0 do
  begin
    while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
    begin
      DispatchMessage(Msg);
    end;
  end;

- Remko

---

这将导致调用应用程序出现挂起，因为它将不再处理消息。 - mghie

抱歉，我忽略了冻结的部分，我已经更正了我的答案。 - Remko

你应该只在MsgWaitForMultipleObjects()特别返回WAIT_OBJECT_0+1时处理消息。对于其他返回值，要相应地进行处理。 - Remy Lebeau

@RemyLebeau 你好，Remy，请问这个的正确答案是什么？ - Steve F

@Remko：需要检查hProcess <> 0，文档甚至都这么说：“即使将fMask设置为SEE_MASK_NOCLOSEPROCESS，如果没有启动进程，则hProcess将为NULL。例如，如果要启动的文档是URL，并且Internet Explorer的一个实例已经在运行，则它将显示该文档。不会启动新进程，hProcess将为NULL... ShellExecuteEx并不总是返回hProcess，即使作为调用结果启动了进程”。 - Remy Lebeau

@SteveF：请看我的回答。 - Remy Lebeau