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;
Ответы
Ответ 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;