从 Delphi 启动 Windows Optimize 应用程序 (Windows 10)

Question

我们有一个旧版 Delphi 7 应用程序，它启动 Windows Defrag 和屏幕键盘应用程序，如下所示：

// Defragmentation application
ShellExecute(0, 'open', PChar('C:\Windows\System32\dfrg.msc'), nil, nil, SW_SHOWNORMAL);

// On-screen keyboard
ShellExecute(0, 'open', PChar('C:\Windows\System32\osk.exe'), nil, nil, SW_SHOWNORMAL);

两者都可以在 Windows XP 上运行，但在 Windows 10 上失败。我发现碎片整理应用程序的名称已更改为 dfrgui.exe，但更新代码并没有帮助。在 Windows 10 上，屏幕键盘仍称为 osk.exe。

这两个应用程序都可以手动/直接从命令行启动，或者在 Windows 资源管理器中双击它们。

我怀疑 Windows 安全性阻止我的应用程序从 C:\Windows\System32 启动任何东西，因为我可以从 Program Files 和 C:\Windows 启动其他几个应用程序。

谁能帮忙？

Answer 1

Delphi 7 只生成 32 位应用程序，没有生成 64 位应用程序的选项（在 XE2 中添加）。

从在 64 位系统上运行的 32 位应用程序访问 %WINDIR%\System32 下的路径受 WOW64 的 File System Redirector 的约束，这会将 64 位 System32 文件夹的请求静默重定向到 32 位SysWOW64 文件夹。

您尝试运行的应用程序可能仅存在于 64 位 System32 文件夹中，而不存在于 32 位 SysWOW64 文件夹中。

为避免重定向，您需要：

• 将System32 替换为路径中的特殊Sysnative 别名（即'C:\Windows\Sysnative\osk.exe'），该别名仅在WOW64 下运行时有效，因此您必须在运行时通过IsWow64Process() 动态检测：

  function GetSystem32Folder: string;
  var
    Folder: array[0..MAX_PATH] of Char;
    IsWow64: BOOL;
  begin
    Result := '';
    if IsWow64Process(GetCurrentProcess(), @IsWow64) and IsWow64 then
    begin
      SetString(Result, Folder, GetWindowsDirectory(Folder, Length(Folder)));
      if Result <> '' then
        Result := IncludeTrailingPathDelimiter(Result) + 'Sysnative' + PathDelim;
    end else
    begin
      SetString(Result, Folder, GetSystemDirectory(Folder, Length(Folder)));
      if Result <> '' then
        Result := IncludeTrailingPathDelimiter(Result);
    end;
  end;
  
  function RunDefrag: Boolean;
  var
    SysFolder: string;
    Res: Integer;
  begin
    SysFolder := GetSystem32Folder;
    Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrgui.exe'), nil, nil, SW_SHOWNORMAL));
    if Res = ERROR_FILE_NOT_FOUND then
      Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrg.msc'), nil, nil, SW_SHOWNORMAL));
    Result := (Res = 0);
  end;
  
  function RunOnScreenKeyboard: Boolean;
  begin
    Result := (ShellExecute(0, nil, PChar(GetSystem32Folder + 'osk.exe'), nil, nil, SW_SHOWNORMAL) = 0);
  end;
  

• 通过Wow64DisableWow64FsRedirection()暂时禁用重定向器，然后在完成后通过Wow64RevertWow64FsRedirection()重新启用它：

  function GetSystem32Folder: string
  var
    Folder: array[0..MAX_PATH] of Char;
  begin
    SetString(Result, Folder, GetSystemDirectory(Folder, Length(Folder)));
    if Result <> '' then
      Result := IncludeTrailingPathDelimiter(Result);
  end;
  
  function RunDefrag: Boolean;
  var
    SysFolder: string;
    OldState: Pointer;
    Res: Integer;
  begin    
    Wow64DisableWow64FsRedirection(@OldState);
    try
      SysFolder := GetSystem32Folder;
      Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrgui.exe'), nil, nil, SW_SHOWNORMAL));
      if Res = ERROR_FILE_NOT_FOUND then
        Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrg.msc'), nil, nil, SW_SHOWNORMAL));
      Result := Res = 0;
    finally
      Wow64RevertWow64FsRedirection(OldState);
    end;
  end;
  
  function RunOnScreenKeyboard: Boolean;
  var
    OldState: Pointer;
  begin
    Wow64DisableWow64FsRedirection(@OldState);
    try
      Result := (ShellExecute(0, nil, PChar(GetSystem32Folder + 'osk.exe'), nil, nil, SW_SHOWNORMAL) = 0);
    finally
      Wow64RevertWow64FsRedirection(OldState);
    end;
  end;
  

更新：话虽如此，原来在WOW64下运行的32位进程在启用UAC时不允许运行osk.exe：

Delphi - On Screen Keyboard (osk.exe) works on Win32 but fails on Win64

因此，当您的应用在 WOW64 下运行时，您必须创建一个 64 位辅助进程来代表您的应用启动 osk.exe。

Answer 2

Remy Lebeau 回答的一个小补充：

如果 Wow64DisableWow64FsRedirection 在您的 Delphi 版本中不可用，和/或如果您不确定您的目标平台是否支持此 API，您可以使用以下代码示例动态调用该函数：

https://www.delphipraxis.net/155861-windows-7-64bit-redirection.html

function ChangeFSRedirection(bDisable: Boolean): Boolean;
type
     TWow64DisableWow64FsRedirection = Function(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
     TWow64EnableWow64FsRedirection = Function(var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
var
    hHandle: THandle;
    Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection;
    Wow64EnableWow64FsRedirection: TWow64EnableWow64FsRedirection;
    Wow64FsEnableRedirection: LongBool;
begin
  Result := false;

  try
    hHandle := GetModuleHandle('kernel32.dll');
    @Wow64EnableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64EnableWow64FsRedirection');
    @Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64DisableWow64FsRedirection');

    if bDisable then
    begin
     if (hHandle <> 0) and (@Wow64DisableWow64FsRedirection <> nil) then
     begin
       Result := Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
     end;
    end else
    begin
     if (hHandle <> 0) and (@Wow64EnableWow64FsRedirection <> nil) then
     begin
       Result := Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);
       Result := True;
     end;
    end;
  Except
  end;
end;