Delphi 7 32 bit thực hiện và đợi 64 bit quá trình

Question

Tôi đã sử dụng chức năng dưới đây để bắt đầu và chờ cho đến khi kết thúc quá trình.

Nó hoạt động tốt để bắt đầu và chờ xử lý 32 bit trên hệ điều hành 32 bit hoặc 64 bit.

Nhưng trên hệ điều hành 64 bit, nó trả về ngay lập tức khi tôi khởi chạy quá trình 64 bit (WaitForSingleObject = WAIT_OBJECT_0). Ví dụ, nếu ứng dụng của tôi (32 bit), khởi động mstsc.exe trên một hệ điều hành 32 bit nó là ok nhưng nó không chờ đợi trên một hệ điều hành 64 bit chắc chắn bởi vì mstsc.exe là một chương trình 64 bit.

Bất kỳ giải pháp nào?

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

tôi đoán là những điều sau đây sẽ xảy ra:

1. Bạn có một quá trình 32 bit chạy trong giả lập WOW64 dưới 64 bit Windows.
2. Bạn cố gắng bắt đầu một quy trình mới có tên mstsc.exe.
3. Hệ thống tìm kiếm trên đường dẫn cho điều đó và tìm thấy nó trong thư mục hệ thống.
4. Vì bạn chạy dưới WOW64, thư mục hệ thống là thư mục hệ thống 32 bit, SysWOW64.
5. Quá trình bắt đầu và ngay lập tức phát hiện rằng đó là một quá trình 32 bit chạy dưới WOW64 theo hệ thống 64 bit.
6. 32 bit mstsc.exe sau đó xác định rằng nó cần phải bắt đầu phiên bản 64 bit của mstsc.exe, mà nó làm, đi qua trên bất kỳ đối số dòng lệnh, và sau đó ngay lập tức chấm dứt.

Điều này sẽ giải thích lý do quy trình mới của bạn ngay lập tức chấm dứt.

Một số giải pháp khả thi:

1. Disable hệ thống tập tin chuyển hướng trước khi bạn bắt đầu quá trình mới. Rõ ràng bạn nên kích hoạt lại nó ngay lập tức sau đó.
2. Tạo một chương trình 64 bit nhỏ nằm trong cùng thư mục với tệp thực thi của bạn, công việc duy nhất là khởi chạy chương trình. Bạn có thể bắt đầu quá trình này và yêu cầu nó khởi chạy quá trình khác. Điều đó sẽ cho phép bạn thoát khỏi các bộ ly hợp của trình giả lập và chuyển hướng của nó.

Answer 2

Trong trường hợp khởi chạy mstsc.exe từ chương trình 32 bit trên hệ điều hành 64, tôi đã sửa đổi chức năng như thế này (đây là lần thử đầu tiên không phải phiên bản chính xác) ans nó hoạt động như một sự quyến rũ!

Cảm ơn bạn @DavidHeffernan! Tuy nhiên, hãy lưu ý rằng nếu bạn không biết quy trình nào sẽ được khắc phục (và hành vi của nó), bạn cần phải xem xét giải pháp toàn cầu @RemyLebeau.

Cảm ơn bạn!

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;