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存在

enter image description here

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。

以下是您的解决方法：

在32位系统上，您只需拨打ShellExecuteEx即可打开osk。
在64位系统上，如果您的流程为64位，则可以再次致电ShellExecuteEx以打开osk。
在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

<session-config>
    <session-timeout>120</session-timeout>
    <cookie-config>
        <domain>example.com</domain>
        <http-only>true</http-only>
        <secure>true</secure>
    </cookie-config>
</session-config>

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上运行良好。从理论上讲，我还没有尝试过使用其他版本，这应该适用于所有版本的OS，但64位Vista之前的版本除外。不会显示，但是32位编译的应用程序将在32位和64位Windows的所有版本上运行。

Delphi - 屏幕键盘（osk.exe）在Win32上运行但在Win64上运行失败

3 个答案: