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

Question

I used to use the function below to start and wait unil the end of a process.

It works fine for starting and waiting for 32 bits process on a 32 bits or 64 bits OS.

But on a 64 bits OS, it returns immediately when i launch a 64 bits process (WaitForSingleObject = WAIT_OBJECT_0).

For example, if my app (32 bits), launch mstsc.exe on a 32 bits OS it is ok but it don't wait on a 64 bits OS certainly because mstsc.exe is a 64 bits program.

Any solution ?

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

My guess is that the following happens:

1. You have a 32 bit process running in the WOW64 emulator under 64 bit Windows.
2. You attempt to start a new process named mstsc.exe .
3. The system searches on the path for that and finds it in the system directory.
4. Because you run under WOW64, the system directory is the 32 bit system directory, SysWOW64.
5. The process starts and immediately detects that it is a 32 bit process running under WOW64 under a 64 bit system.
6. The 32 bit mstsc.exe then determines that it needs to start the 64 bit version of mstsc.exe , which it does, passing on any command line arguments, and then immediately terminates.

This would explain why your new process immediately terminates.

Some possible solutions:

1. Disable file system redirection before you start the new process. Obviously you should re-enable it immediately afterwards.
2. Create a small 64 bit program that lives in the same directory as your executable, whose sole job is to launch programs. You can start this process and ask it to launch the other process. That would allow you to escape from the clutches of the emulator and its redirection.

Answer 2

In the case of launching mstsc.exe from a 32 bits program on a 64 OS, I modified the function like this (it is a first try not the definitive version) ans it works like a charm !

Thank you @DavidHeffernan !

But be aware that if you don't know what process will be lauched (and its behavio) you need to consider @RemyLebeau global solution.

Thanks you !

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;