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; 

Answer 1

我的猜测是，发生以下情况：

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

这可以解释为什么你的新进程立即终止。

一些可能的解决方案：启动新的进程

1. 禁用文件系统重定向之前。显然你应该在之后立即重新启用它。
2. 创建一个小的64位程序，它与您的可执行文件位于相同的目录中，其唯一工作就是启动程序。你可以开始这个过程，并要求它启动另一个过程。这将允许你逃离模拟器的离合器及其重定向。

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;