Подтвердить что ты не робот

Delphi 7 32 бита выполняют и ожидают 64-битный процесс

Я использовал функцию ниже, чтобы начать и ждать завершения процесса.

Он отлично работает для запуска и ожидания 32-битного процесса на 32-битной или 64-битной ОС.

Но в 64-разрядной ОС он немедленно возвращается, когда я запускаю 64-битный процесс (WaitForSingleObject = WAIT_OBJECT_0).

Например, если мое приложение (32 бита) запускает mstsc.exe на 32-битной ОС, это нормально, но он не ждет 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;
4b9b3361

Ответ 1

Я предполагаю, что происходит следующее:

  • У вас есть 32-разрядный процесс, запущенный в эмуляторе WOW64 под 64-разрядной версией Windows.
  • Вы пытаетесь запустить новый процесс с именем mstsc.exe.
  • Система ищет путь к этому пути и находит его в системном каталоге.
  • Поскольку вы работаете под WOW64, системный каталог представляет собой 32-битный системный каталог SysWOW64.
  • Процесс запускается и сразу обнаруживает, что это 32-битный процесс, запущенный под WOW64 под 64-разрядной системой.
  • 32-разрядный mstsc.exe затем определяет, что ему нужно запустить 64-разрядную версию mstsc.exe, которую он выполняет, передавая любые аргументы командной строки и затем немедленно заканчивая.

Это объясняет, почему ваш новый процесс немедленно прекращается.

Некоторые возможные решения:

  • Отключить перенаправление файловой системы перед запуском нового процесса. Очевидно, вы должны снова включить его сразу же после этого.
  • Создайте небольшую 64-битную программу, которая живет в том же каталоге, что и ваш исполняемый файл, единственной задачей которого является запуск программ. Вы можете начать этот процесс и попросить его запустить другой процесс. Это позволит вам выйти из лап эмулятора и перенаправления.

Ответ 2

В случае запуска mstsc.exe из 32-битной программы на 64-й ОС я модифицировал эту функцию (это первая попытка не окончательная версия), и она работает как шарм!

Спасибо @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;