Delphi 7 32位执行并等待64位进程

Question

我曾经使用下面的函数来启动并等待进程结束。

对于在32位或64位操作系统上启动和等待32位进程，它可以正常工作。

但是，在64位操作系统上，当我启动64位进程时，它会立即返回（WaitForSingleObject = WAIT_OBJECT_0）。

例如，如果我的应用程序（32位）在32位操作系统上启动mstsc.exe，则可以，但在64位操作系统上不行，因为mstsc.exe是一个64位程序。

有什么解决办法吗？

function gShellExecuteAndWait(
                              vHandle     : HWND;
                              vOperation  : string;
                              vFichier    : string;
                              vParametres : string;
                              vRepertoire : string;
                              vAffichage  : Integer;
                              vDuree      : DWORD;
                              var vErreur : string
                             ) : Boolean;
var
  vSEInfo  : TShellExecuteInfo;
  vAttente : DWORD;
begin
  // Initialisation
  Result   := True;
  vErreur  := '';
  vAttente := 0;

  // Initialisation de la structure ShellExecuteInfo
  ZeroMemory(@vSEInfo, SizeOf(vSEInfo));

  // Remplissage de la structure ShellExecuteInfo
  vSEInfo.cbSize       := SizeOf(vSEInfo);
  vSEInfo.fMask        := SEE_MASK_NOCLOSEPROCESS;
  vSEInfo.Wnd          := vHandle;
  vSEInfo.lpVerb       := PAnsiChar(vOperation);
  vSEInfo.lpFile       := PAnsiChar(vFichier);
  vSEInfo.lpParameters := PAnsiChar(vParametres);
  vSEInfo.lpDirectory  := PAnsiChar(vRepertoire);
  vSEInfo.nShow        := vAffichage;

  // L'exécution a réussi
  if ShellExecuteEx(@vSEInfo) then
  begin
    // Attendre la fin du process ou une erreur
    while True do
    begin

      case WaitForSingleObject(vSEInfo.hProcess, 250) of

        WAIT_ABANDONED :
        begin
          Result  := False;
          vErreur := 'L''attente a été annulée.';
          Break;
        end;

        WAIT_OBJECT_0 :
        begin
          Break;
        end;

        WAIT_TIMEOUT :
        begin
          // Initialisation
          vAttente := vAttente + 250;

          // Le délai d'attente n'a pas été atteint
          if vAttente < vDuree then
          begin
            Application.ProcessMessages();
          end

          // Le délai d'attente est dépassé
          else
          begin
            Result  := False;
            vErreur := 'Le délai d''attente a été dépassé.';
            Break;
          end;
        end;

        WAIT_FAILED :
        begin
          Result := False;
          vErreur := SysErrorMessage(GetLastError());
          Break;
        end;
      end;
    end;
  end

  // L'exécution a échoué
  else
  begin
    Result  := False;
    vErreur := SysErrorMessage(GetLastError());
  end;
end;

- NMD

---

顺便说一下，您正在启动一个新进程，您知道可执行文件的名称。CreateProcess是用于此目的的API。ShellExecuteEx是在需要外壳来解决如何执行它时使用的。由于您知道可执行文件的名称，因此在我看来，直接调用CreateProcess更有意义。 - David Heffernan

@DavidHeffernan 你说得对！ - NMD

Answer 1

我的猜想是下面的情况发生了：

1. 您正在64位Windows下的WOW64模拟器中运行32位进程。
2. 您尝试启动名为mstsc.exe的新进程。
3. 系统在路径上搜索并在系统目录中找到它。
4. 由于您在WOW64下运行，因此系统目录是32位系统目录SysWOW64。
5. 进程启动并立即检测到它是在64位系统下运行的32位进程。
6. 32位的mstsc.exe然后确定需要启动64位版本的mstsc.exe，它会传递任何命令行参数，然后立即终止。

这可能解释了为什么您的新进程立即终止。

一些可能的解决方案：

1. 在启动新进程之前禁用文件系统重定向。显然，您应该立即重新启用它。
2. 创建一个小的64位程序，与您的可执行文件位于同一个目录中，其唯一工作是启动程序。您可以启动此进程并要求它启动其他进程。这将允许您摆脱模拟器及其重定向的控制。

- David Heffernan

---

如果你的生成进程很快就终止，第三个选择可能是使用CreateToolhelp32Snapshot()枚举正在运行的进程，检查是否有任何进程是由已终止的进程生成的，如果是，则调用OpenProcess()打开其报告的进程ID并根据需要等待它。 - Remy Lebeau

+1 FWIW，我可以确认32位的mstsc启动了64位的mstsc，但我确实想知道为什么它确定需要启动64位版本？像记事本这样的简单应用程序就不会发生这种情况。 - Lieven Keersmaekers

@Lieven 这是终端服务客户端，不是吗？想必它足够复杂，无法在模拟器中运行。 - David Heffernan

@DavidHeffernan - 看起来有很多相关的问题，但我还没有找到真正的原因。我认为你是对的。 - Lieven Keersmaekers

@DavidHeffernan 你说得对。如果我在SysWOW64中重命名mstsc.exe，我会收到“文件未找到”的提示。因此，mstsc.exe在SysWOW64中启动，然后重新在System32中启动64位版本。我将尝试按照您提到的禁用系统重定向并返回结果。似乎这只适用于mstsc.exe，因为notepad.exe不会出现相同的情况。 - NMD

Answer 2

在64位操作系统上从32位程序启动mstsc.exe的情况下，我修改了该函数（这是第一次尝试而不是最终版本），它工作得很好！

谢谢@DavidHeffernan!

但请注意，如果您不知道将启动什么进程（以及其行为），则需要考虑@RemyLebeau的全局解决方案。

谢谢！

function gShellExecuteAndWait(
                              vHandle     : HWND;
                              vOperation  : string;
                              vFichier    : string;
                              vParametres : string;
                              vRepertoire : string;
                              vAffichage  : Integer;
                              vDuree      : DWORD;
                              var vErreur : string
                             ) : Boolean;
var
  vSEInfo  : TShellExecuteInfo;
  vAttente : DWORD;

  IsWow64Process                 :function(aProcess: THandle; var aWow64Process: Bool): Bool; stdcall;
  Wow64DisableWow64FsRedirection :function(aOldValue :pointer) :Bool; stdcall;
  Wow64RevertWow64FsRedirection  :function(aOldValue :pointer) :Bool; stdcall;


  Wow64 :Bool;
  OldFs :pointer;
begin
  // Initialisation
  Result   := True;
  vErreur  := '';
  vAttente := 0;
  OldFS    := nil;

  IsWow64Process := Windows.GetProcAddress(Windows.GetModuleHandle('kernel32.dll'), 'IsWow64Process');

  if Assigned(IsWow64Process) then
  begin
    IsWow64Process(GetCurrentProcess, Wow64);
  end
  else
  begin
    Wow64 := False;
  end;

  if Wow64 then
  begin
    Wow64DisableWow64FsRedirection := GetProcAddress(Windows.GetModuleHandle('kernel32.dll'), 'Wow64DisableWow64FsRedirection');

    Wow64DisableWow64FsRedirection(OldFS);
  end;


  // Initialisation de la structure ShellExecuteInfo
  ZeroMemory(@vSEInfo, SizeOf(vSEInfo));

  // Remplissage de la structure ShellExecuteInfo
  vSEInfo.cbSize       := SizeOf(vSEInfo);
  vSEInfo.fMask        := SEE_MASK_NOCLOSEPROCESS;
  vSEInfo.Wnd          := vHandle;
  vSEInfo.lpVerb       := PAnsiChar(vOperation);
  vSEInfo.lpFile       := PAnsiChar(vFichier);
  vSEInfo.lpParameters := PAnsiChar(vParametres);
  vSEInfo.lpDirectory  := PAnsiChar(vRepertoire);
  vSEInfo.nShow        := vAffichage;

  // L'exécution a réussi
  if ShellExecuteEx(@vSEInfo) then
  begin
    // Attendre la fin du process ou une erreur
    while True do
    begin

      case WaitForSingleObject(vSEInfo.hProcess, 250) of

        WAIT_ABANDONED :
        begin
          Result  := False;
          vErreur := 'L''attente a été annulée.';
          Break;
        end;

        WAIT_OBJECT_0 :
        begin
          Break;
        end;

        WAIT_TIMEOUT :
        begin
          // Initialisation
          vAttente := vAttente + 250;

          // Le délai d'attente n'a pas été atteint
          if vAttente < vDuree then
          begin
            Application.ProcessMessages();
          end

          // Le délai d'attente est dépassé
          else
          begin
            Result  := False;
            vErreur := 'Le délai d''attente a été dépassé.';
            Break;
          end;
        end;

        WAIT_FAILED :
        begin
          Result := False;
          vErreur := SysErrorMessage(GetLastError());
          Break;
        end;
      end;
    end;
  end

  // L'exécution a échoué
  else
  begin
    Result  := False;
    vErreur := SysErrorMessage(GetLastError());
  end;

  if Wow64 then
  begin
    Wow64RevertWow64FsRedirection := GetProcAddress(Windows.GetModuleHandle('kernel32.dll'), 'Wow64RevertWow64FsRedirection');
    Wow64RevertWow64FsRedirection(OldFs);
  end;
end;

- NMD

---

你禁用重定向的时间太长了。我肯定会使用CreateProcess。但是即使使用ShellExecuteEx，步骤也是相同的：DisableFSR，调用ShellExecuteEx，EnableFST，等待进程完成。 - David Heffernan