Delphi 7 32 bit eseguono e attendono il processo a 64 bit

Question

Ho usato la funzione seguente per avviare e attendere fino alla fine di un processo.

Funziona correttamente per l'avvio e l'attesa per il processo a 32 bit su un sistema operativo a 32 bit o 64 bit.

Ma su un sistema operativo a 64 bit, viene restituito immediatamente all'avvio di un processo a 64 bit (WaitForSingleObject = WAIT_OBJECT_0).

Ad esempio, se la mia app (32 bit), avvia mstsc.exe su un sistema operativo a 32 bit, è ok ma non attende su un sistema operativo a 64 bit perché mstsc.exe è un programma a 64 bit.

Qualsiasi soluzione?

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

La mia ipotesi è che si verifica quanto segue:

1. È disporre di un processo a 32 bit in esecuzione nell'emulatore WOW64 in Windows a 64 bit.
2. Si tenta di avviare un nuovo processo denominato mstsc.exe.
3. Il sistema cerca nel percorso per quello e lo trova nella directory di sistema.
4. Poiché si esegue WOW64, la directory di sistema è la directory di sistema a 32 bit, SysWOW64.
5. Il processo inizia e rileva immediatamente che si tratta di un processo a 32 bit in esecuzione in WOW64 in un sistema a 64 bit.
6. Il 32 bit mstsc.exe determina quindi che è necessario avviare la versione a 64 bit di mstsc.exe, che esegue, passando su qualsiasi argomento della riga di comando e quindi termina immediatamente.

Questo spiegherebbe perché il nuovo processo termina immediatamente.

Alcune soluzioni possibili:

1. Disabilita reindirizzamento del file system prima di avviare il nuovo processo. Ovviamente dovresti riattivarlo subito dopo.
2. Creare un piccolo programma a 64 bit che risiede nella stessa directory del file eseguibile, il cui unico compito è quello di avviare programmi. È possibile avviare questo processo e chiedere di avviare l'altro processo. Ciò ti permetterebbe di sfuggire alle grinfie dell'emulatore e al suo reindirizzamento.

Answer 2

In caso di avvio di mstsc.exe da un programma a 32 bit su un sistema operativo 64, ho modificato la funzione in questo modo (è una prima prova non la versione definitiva) e funziona come un incantesimo!

Grazie @DavidHeffernan!

Ma essere consapevoli del fatto che se non si conosce il processo che verrà avviato (e il suo comportamento) è necessario prendere in considerazione la soluzione globale di @RemyLebeau.

Grazie!

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;