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

Question

我们有一个传统的Delphi 7应用程序，它启动Windows和屏幕上的键盘应用程序如下：

// 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上工作，但在Windows 10上都失败了。我注意到碎片整理应用程序已经更改了dfrgui.exe的名称，但是更新代码没有帮助。在Windows 10上，屏幕上的键盘仍然被称为osk.exe .

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

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

有人能帮忙吗？

Answer 1

Delphi7只生产32位应用程序，没有任何选项可以生成64位应用程序(这是在XE2中添加的)。

从运行在64位系统上的32位应用程序访问%WINDIR%\System32下的路径取决于for 64的File System Redirector，后者将静默地将64位System32文件夹的请求重定向到32位SysWOW64文件夹。

很可能，你试图运行的应用程序只存在于64位System32文件夹中，而不存在于32位SysWOW64文件夹中。

为了避免重定向，您需要：

• 将System32替换为路径中的特殊Sysnative别名(即'C:\Windows\Sysnative\osk.exe')，该别名仅在WOW64下运行时才能工作，因此您必须在运行时通过IsWow64Process()动态检测该别名： 函数GetSystem32Folder: string；var文件夹: array0..MAX_PATH of Char；IsWow64: BOOL；begin Result :=‘；if IsWow64Process(GetCurrentProcess()，@ if 64)和IsWow64，然后开始SetString(结果、文件夹、GetWindowsDirectory(文件夹、长度(文件夹))；如果结果<>’那么结果:= IncludeTrailingPathDelimiter(结果)+ 'Sysnative‘+ PathDelim；结束IsWow64Process(结果，文件夹，GetSystemDirectory(文件夹，长度(文件夹)；如果结果<> '‘，则结果:= IncludeTrailingPathDelimiter(结果)；结束；函数RunDefrag:布尔；变量SysFolder:字符串；Res:整数；begin SysFolder := GetSystem32Folder；Res := Integer(ShellExecute(0，nil，PChar(SysFolder + 'dfrgui.exe')，nil，nil，SW_SHOWNORMAL)；如果Res = ERROR_FILE_NOT_FOUND，则Res := Integer(ShellExecute(0，nil，PChar(ShellExecute+’en19#)，nil，nil，))；结果:= (Res = 0)；end；RunOnScreenKeyboard函数: Boolean；ShellExecute(0，nil，PChar(GetSystem32Folder + 'osk.exe')，nil，nil，SW_SHOWNORMAL) = 0)；
• 通过Wow64DisableWow64FsRedirection()暂时禁用重定向器，然后通过Wow64RevertWow64FsRedirection()重新启用它： 函数GetSystem32Folder: string文件夹: array0..MAX_PATH of Char；begin SetString(结果、文件夹，GetSystemDirectory(文件夹，长度(文件夹)；如果结果<> '‘那么结果:= IncludeTrailingPathDelimiter(结果)；结束；函数RunDefrag:布尔；var SysFolder: string；OldState:指针；Res: Integer；begin Wow64DisableWow64FsRedirection(@OldState)；SysFolder := GetSystem32Folder；Res := Integer(ShellExecute(0，nil，PChar(SysFolder +’PChar‘)，nil，nil，))；如果Res = ERROR_FILE_NOT_FOUND，则Res :=整数(ShellExecute(0，nil，PChar(SysFolder + 'dfrg.msc')，nil，nil，SW_SHOWNORMAL))；结果:= Res = 0；最终Wow64RevertWow64FsRedirection(OldState)；end；函数RunOnScreenKeyboard:布尔；var OldState:指针；begin Wow64DisableWow64FsRedirection(@OldState)；尝试结果:= (ShellExecute(0，nil，PChar(GetSystem32Folder + 'osk.exe')，0，nil，GetSystem32Folder)= 0)；最后Wow64RevertWow64FsRedirection(OldState)；结束；结束；

Update：也就是说，如果启用了UAC，则不允许运行在WOW64下的32位进程运行osk.exe：

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

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

Answer 2

雷米·莱博回答的一个小问题是：

如果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;