Delphi - 屏幕键盘 (osk.exe) 在 Win32 上工作但在 Win64 上失败

Question

我正在尝试从我的应用程序运行屏幕键盘。它在 Windows XP 32 位下正常工作，但在 Win 7 64 位下不正确。

unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellAPI;

type
  TForm5 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
   class function IsWOW64: Boolean;
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}


procedure TForm5.FormCreate(Sender: TObject);
var path:String;
    res : Integer;

function GetSysDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
  Len: UINT;
  S: String;
begin
  {$IFNDEF WIN64}
  if TForm5.IsWOW64 then
  begin
    Len := GetWindowsDirectory(Buf, MAX_PATH);
    if Len = 0 then RaiseLastOSError;
    SetString(S, Buf, Len);
    Result := IncludeTrailingPathDelimiter(S) + 'Sysnative\';
    Exit;
  end;
  {$ENDIF}
  Len := GetSystemDirectory(Buf, MAX_PATH);
  if Len = 0 then RaiseLastOSError;
  SetString(S, Buf, Len);
  Result := IncludeTrailingPathDelimiter(S);
end;

begin
 path := GetSysDir;

 path := path + 'osk.exe';

  res := ShellExecute(self.Handle,'open',Pchar(path),nil,nil,SW_NORMAL);

 if res <> 42 then
  begin
   ShowMessage(path);
   RaiseLastOSError;
  end;
end;

class function TForm5.IsWOW64: Boolean;
type
  TIsWow64Process = function( // Type of IsWow64Process API fn
    Handle: THandle;
    var Res: BOOL
  ): BOOL; stdcall;
var
  IsWow64Result: BOOL;              // result from IsWow64Process
  IsWow64Process: TIsWow64Process;  // IsWow64Process fn reference
begin
  // Try to load required function from kernel32
  IsWow64Process := GetProcAddress(
    GetModuleHandle('kernel32'), 'IsWow64Process'
  );
  if Assigned(IsWow64Process) then
  begin
    // Function is implemented: call it
    if not IsWow64Process(GetCurrentProcess, IsWow64Result) then
     RaiseLastOSError;
    // Return result of function
    Result := IsWow64Result;
  end
  else
    // Function not implemented: can't be running on Wow64
    Result := False;
end;


end.

在 x64 下运行应用程序会显示路径 C:\Windows\Sysnative\osk.exe ，并引发“调用 OS 函数失败”错误。

搜索 windows 目录显示 osk.exe 存在

Answer 1

UAC 下的 osk 有一些特别之处。此代码失败，错误代码为 740，ERROR_ELEVATION_REQUIRED，请求的操作需要提升。

var
  si: TStartupInfo;
  pi: TProcessInformation;
....
si.cb := SizeOf(si);
GetStartupInfo(si);
Win32Check(CreateProcess('C:\Windows\system32\osk.exe', nil, nil, nil, 
  False, 0, nil, nil, si, pi));

在具有 UAC 的计算机上，这在 32 位和 64 位进程下都会失败。你可以在这里找到一些关于这个问题的讨论：https://web.archive.org/web/20170311141004/http://blog.delphi-jedi.net/2008/05/17/the-case-of-shellexecute-shellexecuteex-createprocess-and-oskexe/

所以您的问题与 32 位或 64 位无关，而是您的 XP 系统没有 UAC。

更广泛地说，我认为这足以说服您再也不要致电ShellExecute。它只存在于 16 位兼容性，并且在报告错误方面毫无用处。如果您想要错误，请致电ShellExecuteEx。但是，由于我们正在启动一个新进程，CreateProcess 通常是正确调用的 API。

也就是说，在这种特定情况下，osk 的设计使得它无法由CreateProcess 以编程方式启动。它确实需要由ShellExecute 或ShellExecuteEx 调用。这允许 shell 执行它的 UAC 魔法。现在，事实证明，32 位 WOW64 进程不可能发生魔法。解决方案是从 64 位进程启动 osk，并调用 ShellExecuteEx。

这是您的解决方法：

1. 在 32 位系统上，您只需调用 ShellExecuteEx 即可打开 osk。
2. 在 64 位系统上，如果您的进程是 64 位，您可以再次调用 ShellExecuteEx 以打开 osk。
3. 在 64 位系统上，如果您的进程是 32 位 WOW64 进程，则需要启动一个单独的 64 位进程，该进程依次调用 ShellExecuteEx 来打开 osk。

由于您似乎没有使用 64 位版本的 Delphi，因此您需要找到 64 位编译器。您可以使用 64 位 fpc 或 64 位 C++ 编译器。下面的 C++ 程序就足够了：

#include <Windows.h>
#include <Shellapi.h>

int CALLBACK WinMain(
  HINSTANCE hInstance,
  HINSTANCE hPrevInstance,
  LPSTR lpCmdLine,
  int nCmdShow
)
{
    SHELLEXECUTEINFOW sei = { sizeof(sei) };
    sei.lpVerb = L"open";
    sei.lpFile = L"osk.exe";
    sei.nShow = SW_SHOW;
    ShellExecuteExW(&sei);
}

您可以使用 64 位 C++ 编译器对其进行编译，然后从您的 32 位 WOW64 进程中调用它。我知道啰嗦，但它确实有实际工作的优点！

Answer 2

Function Wow64DisableWow64FsRedirection(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
  External 'Kernel32.dll' Name 'Wow64DisableWow64FsRedirection';

Var
  Wow64FsEnableRedirection: LongBool;
begin
  if Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection) then ShellExecute(0,nil, 'osk.exe', nil, nil, SW_show);
end;

Answer 3

另一个更简单的选择是在 ShellExecute 中使用 SysNative，如下所示：

{  
If UTExistFile(GetWindowsSystemDir() + '\OSK.exe') then  
// we can "see" OSK.exe in the System32 folder, so we are running on 
// 32-bit Windows, so no problem accessing OSK.EXE in System32.
ShellExecute(Application.Handle,       // HWND hwnd
       'open',                   // LPCTSTR lpOperation
        LPCTSTR(GetWindowsSystemDir() + '\OSK.exe'), // LPCTSTR lpFile
        '',                        // LPCTSTR lpParameters
        '',                        // LPCTSTR lpDirectory,
        SW_Show)                   // INT nShowCmd
else     
// Use SysNative to get at OSK.EXE. This will not work for 64-bit OS 
// before Vista (e.g. XP), but it won't lock or crash your system and at
// least you can compile and run the application on all versions of Windows;
// both 32 and 64 bit.
ShellExecute(Application.Handle,    // HWND hwnd
    'open',                         // LPCTSTR lpOperation
    LPCTSTR(GetWindowsDir() + '\SysNative\OSK.EXE'),  // LPCTSTR lpFile
    '',                            // LPCTSTR lpParameters
    '',                            // LPCTSTR lpDirectory,
    SW_Show) ;                     // INT nShowCmd
}

它在 64 位 Windows 10 上运行良好。我还没有在其他版本上尝试过，理论上，这应该适用于所有版本的操作系统，除了 64 位 Vista 之前的版本，在这种情况下 OSK不会显示，但 32 位编译的应用程序将在所有版本的 Windows 32 位和 64 位上运行。