我们有一个旧版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
启动多个其他应用程序。
有人可以帮忙吗?
答案 0 :(得分:8)
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 RunDegrag: 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 RunDegrag: 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;
更新:也就是说,启用UAC后,不允许在WOW64下运行的32位进程运行osk.exe
:
Delphi - On Screen Keyboard (osk.exe) works on Win32 but fails on Win64
因此,当您的应用程序在WOW64下运行时,您将必须创建一个助手64位进程来代表您启动osk.exe
。
答案 1 :(得分:1)
雷米·勒博的答案中的一小部分:
如果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;