解释来自 GetKeyState / GetCursorPos 的错误

Question

有时我会收到来自客户的错误报告，但我无法解释。在 Delphi 中的 Application.Run() 之后，我收到以下错误：

 EOSError: System error: Code:_5 Access denied

 Call Stack Information:
-------------------------------------------------------------------
|Address |Module     |Unit       |Class |Procedure       |Line    |
-------------------------------------------------------------------
|Running Thread: ID=4352; Priorität=0; Klasse=; [Main Thread]     |
|-----------------------------------------------------------------|
|772B291F|USER32.dll |           |      |GetKeyState     |        |
|772B7B96|USER32.dll |           |      |GetPropA        |        |
|772B7B5A|USER32.dll |           |      |GetPropA        |        |
|772A7BC5|USER32.dll |           |      |DispatchMessageA|        |
|772A7BBB|USER32.dll |           |      |DispatchMessageA|        |
|00A6D804|Program.exe|Program.dpr|      |                |803[369]|  // Application.Run
-------------------------------------------------------------------

和

EOsError: A call to an OS function failed

Call Stack Information:
-------------------------------------------------------------------
|Address |Module     |Unit       |Class |Procedure       |Line    |
-------------------------------------------------------------------
|Running Thread: ID=2712; Priorität=0; Klasse=; [Main Thread]     |
|-----------------------------------------------------------------|
|7E379758|USER32.dll |           |      |GetCursorPos    |        |
|7E379ED9|USER32.dll |           |      |GetKeyState     |        |
|7E37B3FC|USER32.dll |           |      |CallNextHookEx  |        |
|7E380078|USER32.dll |           |      |GetPropA        |        |
|7E380042|USER32.dll |           |      |GetPropA        |        |
|7E3696C2|USER32.dll |           |      |DispatchMessageA|        |
|7E3696B8|USER32.dll |           |      |DispatchMessageA|        |
|00A6E823|Program.exe|Program.dpr|      |                |803[369]|  //Application.Run
-------------------------------------------------------------------

在这两种情况下，从 Eurekalog 提交的屏幕截图都是全黑的。

谁能解释一下，是什么导致 GetCursorPos 或 GetKeyState 以这种方式失败？

Answer 1

GetCursorPos 的文档说：

调用GetCursorPos 时输入的桌面必须是当前桌面。调用 OpenInputDesktop 判断当前桌面是否为输入桌面。如果不是，请使用 OpenInputDesktop 返回的 HDESK 调用 SetThreadDesktop 以切换到该桌面。

您可能会遇到这种情况，最常见的是解锁工作站时。在我的代码中，我将 GetCursorPos 替换为这个变体：

function GetCursorPos(var lpPoint: TPoint): BOOL; stdcall;
(* The GetCursorPos API in user32 fails if it is passed a memory address >2GB 
   which breaks LARGEADDRESSAWARE apps.  We counter this by calling GetCursorInfo
   instead which does not suffer from the same problem.

   In addition we have had problems with GetCursorPos failing when called 
   immediately after a password protected screensaver or a locked workstation 
   re-authenticates. This problem initially appeared with XP SP1 and is brought 
   about because TMouse.GetCursorPos checks the return value of the GetCursorPos 
   API call and raises an OS exception if the API has failed.
*)
var
  CursorInfo: TCursorInfo;
begin
  CursorInfo.cbSize := SizeOf(CursorInfo);
  Result := GetCursorInfo(CursorInfo);
  if Result then begin
    lpPoint := CursorInfo.ptScreenPos;
  end else begin
    lpPoint := Point(0, 0);
  end;
end;

您可以使用您喜欢的代码挂钩机制来替换GetCursorPos。我是这样做的：

RedirectProcedure(@Windows.GetCursorPos, @CodePatcher.GetCursorPos);

RedirectProcedure 如下所述：Patch routine call in delphi

对于我的特定场景，GetCursorPos 会失败，但GetCursorInfo 不会失败。但正如 cmets 中所指出的，在某些情况下GetCursorInfo 也会失败。在这种情况下，您可能会发现安排修补后的函数不返回 False 是方便的。

至于GetKeyState，我不确定那个。很可能相似，但GetKeyState 是我个人并不熟悉的 API。

Answer 2

供参考： 感谢答案和 cmets，我发现以下情况可能会触发这些错误：

• Windows 用户切换后登录
• 从受密码保护的屏幕保护程序登录
• VNC/远程桌面服务

我将忽略全局异常处理程序中的错误，如下所示：

procedure MyGlobalExceptionHandler(Sender: TObject; E: Exception);
var
    TopCallStackFunction: string;
begin
    if E is EOSError then
    begin
        TopCallStackFunction := GetEurekalogTopCallStackFunction();

        //EOSError: System error: Code: 5 Access denied, 
        //caused by GetKeyState or EndPaint or GetCursorPos
        if ((E as EOSError).ErrorCode = Windows.ERROR_ACCESS_DENIED) 
          and ((TopCallStackFunction = 'GetKeyState') 
          or (TopCallStackFunction = 'EndPaint')
          or (TopCallStackFunction = 'GetCursorPos')) then
            Exit;

        //EOsError: A call to an OS function failed, caused by GetCursorPos 
        if ((E as EOSError).ErrorCode = 0) 
          and (TopCallStackFunction = 'GetCursorPos') then
            Exit;
    end;

    ... //other error handling
end;

Answer 3

奇怪，在我的测试中，我发现GetCursorInfo 表现出与GetCursorPos 完全相同的问题，至少在密码锁定屏幕被解锁的情况下。

（使用 Delphi 7 和 Windows 7 进行测试，并使用来自 madshi.net 的HookAPI 进行修补）。

测试程序：

1. 创建一个简单的应用程序，只需每秒调用 Mouse.CursorPos（仅在主窗体上放置一个 TTimer 和一个 TEdit，Timer 代码如下所示）。
2. 将 CodePatcher 单元添加到项目中。
3. 运行应用程序。
4. 锁定屏幕（标志-L）。
5. 输入密码解锁屏幕。

David Heffernan 的原始代码的结果：

//== BOF BUG REPORT =================================================
operating system  : Windows 7 x64 Service Pack 1 build 7601
executable        : Project1.exe
compiled with     : Delphi 7
madExcept version : 3.0o

exception class   : EOSError
exception message : System Error. Code: 5. Access is denied.

main thread ($1b48):
0045c513 +73 Project1.exe SysUtils           RaiseLastOSError
0045c543 +07 Project1.exe SysUtils           Win32Check
00487dc1 +09 Project1.exe Controls 10578  +1 TMouse.GetCursorPos
0049dc7f +27 Project1.exe Unit1       32  +1 TForm1.Timer1Timer
//== EOF BUG REPORT =================================================

“Result := True;”时的结果行未注释：

未引发异常。

---

源文件

//==BOF PROJECT1.DPR========================================================================
program Project1;

uses
  madExcept,
  madLinkDisAsm,
  madListHardware,
  madListProcesses,
  madListModules,
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  CodePatcher in 'CodePatcher.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
//==EOF PROJECT1.DPR========================================================================

//==BOF UNIT1.PAS========================================================================
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Edit1: TEdit;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Edit1.Text := IntToStr(Mouse.CursorPos.X);
end;

end.
//==EOF UNIT1.PAS========================================================================


//==BOF CODEPATCHER.PAS========================================================================
unit CodePatcher;

interface

implementation

uses
  Windows, Types, madCodeHook;

var GetCursorPosNextHook : function (var lpPoint: TPoint): BOOL; stdcall;

// David Heffernan's solution
function GetCursorPosHookProc(var lpPoint: TPoint): BOOL; stdcall;
var
  CursorInfo: TCursorInfo;
begin
  CursorInfo.cbSize := SizeOf(CursorInfo);
  Result := GetCursorInfo(CursorInfo);
  if Result then begin
    lpPoint := CursorInfo.ptScreenPos;
  end else begin
    lpPoint := Point(0, 0);
    // Uncomment next line to avoid exception caused by TMouse.GetCursorPos
    //Result := True;
  end;
end;

initialization
  HookAPI('user32.dll', 'GetCursorPos', @GetCursorPosHookProc, @GetCursorPosNextHook);

finalization
  UnhookAPI(@GetCursorPosNextHook);

end.
//==EOF CODEPATCHER.PAS========================================================================

---