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;