Delphi - 在Win32上可以使用屏幕键盘(osk.exe)，但在Win64上失败了。

Question

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

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，并引发“调用操作系统函数失败”的错误。

在Windows目录中搜索可发现osk.exe存在。

- RBA

---

在调用ShellExecute之后，错误处理是什么意思？42有什么特别之处吗？而且ShellExecute不使用上一个错误。如果您想要错误检查，请使用ShellExecuteEx或CreateProcess。 - David Heffernan

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位进程调用ShellExecuteEx来启动osk。

这是您的解决方法：

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进程中调用它。虽然这样说有些冗长，但确实行得通！

- David Heffernan

---

好的，在我的开发系统上UAC已经禁用了...很棒的发现。 - Sir Rufo

@sirrufo，您应该启用UAC！ - David Heffernan

像往常一样，你是正确的...阅读完文章后，似乎问题与UAC有关。 - RBA

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;

- user10911532

---

最好编辑您的答案并添加解释为什么/如何这段代码解决了问题。 - barbsan

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之前的所有OS版本以外的所有版本，此时OSK不会显示，但32位编译的应用程序将在所有32位和64位Windows版本上运行。

- John Santmann

---

好像自 Windows 10 版本 1803 起，SysNative 不再与 ShellExecute 兼容了。唉！ - John Santmann