delphi 如何获得系统的真实空闲时间？

我需要在应用程序中触发事件时获取系统空闲时间。我使用了GetLastInputInfo()函数来获取它，但似乎在5分零几秒钟的不活动后，我的空闲计数器重新启动回零，没有我触摸鼠标或键盘。我的屏幕保护程序被停用，也是所有的待机和睡眠设置的系统和显示!
原因可能是什么？
我用这段代码来测试这个问题：

procedure TMsgForm.Timer1Timer(Sender: TObject);
var mins, secs, T0, T1, TD: Cardinal;
    LastInput: TLastInputInfo;
begin
  LastInput.cbSize:=SizeOf(TLastInputInfo);
  if not GetLastInputInfo(LastInput) then Caption := 'error'
  else begin
    T0 := GetTickCount;
    T1 := LastInput.dwTime;
    TD := T0 - T1;
    secs := TD div 1000;
    mins := secs div 60;
    Caption := 'T0='+IntToStr(T0)+'  T1='+IntToStr(T1)+'  TD='+IntToStr(TD)+'  secs='+IntToStr(secs)+'  mins='+IntToStr(mins);
  end;
end;

- 更新：**

我关闭了所有程序，然后再等5分钟，同样的事情发生了。我想我安装的某个程序可能是在模拟用户输入之类的，所以重置了空闲计数器。但事实并非如此一定是系统里的什么东西干的？
我也试过另一台电脑，它工作得很好。5分钟后未重置。

- 更新**

很奇怪挂接键盘和鼠标，我没有收到任何目前的标准空闲计数器重置。因此，唯一合乎逻辑的结论是计数器从其他源重新启动。

我设法通过安装键盘和鼠标挂钩来获得真实的的空闲时间，它有一个标志，可以告诉触发器的来源是否真实。它工作，但它不是一个很好的实现。我不敢相信微软没有考虑过为真实的事件实现一个系统空闲计时器，比如GetLastInputInfo(LastInput)。
我不知道是否有其他的输入来源，然后键盘和鼠标...如果有人能帮助我改进这个程序，我很欢迎。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Panel2: TPanel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TrueLastInput: DWORD;

implementation

{$R *.dfm}

const
  LLKHF_INJECTED = $00000010;
  LLKHF_LOWER_IL_INJECTED = $00000002;
  LLMHF_INJECTED = $00000001;
  LLMHF_LOWER_IL_INJECTED = $00000002;

type
  TLowLevelInputProc = function(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

  PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
  TKBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;

  PMOUSEHOOKSTRUCT = ^TMOUSEHOOKSTRUCT;
  TMOUSEHOOKSTRUCT = record
    pt: TPoint;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;

var
  KHook, MHook: HHOOK;

function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var Info: PKBDLLHOOKSTRUCT;
begin
  if nCode >= 0 then begin
    Info:= PKBDLLHOOKSTRUCT(lParam);
    if (Info.flags and (LLKHF_INJECTED or LLKHF_LOWER_IL_INJECTED)) = 0 then
      TrueLastInput:= Info.time;
  end;
  Result:= CallNextHookEx(KHook, nCode, wParam, lParam);
end;

function MouseProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var Info: PMOUSEHOOKSTRUCT;
begin
  if nCode >= 0 then begin
    Info:= PMOUSEHOOKSTRUCT(lParam);
    if (Info.flags and (LLMHF_INJECTED or LLMHF_LOWER_IL_INJECTED)) = 0 then
      TrueLastInput:= Info.time;
  end;
  Result:= CallNextHookEx(MHook, nCode, wParam, lParam);
end;

procedure InstallInputHooks;
var LLKeyboardProc, LLMouseProc: TLowLevelInputProc;
begin
  LLKeyboardProc:= @KeyboardProc;
  KHook:= SetWindowsHookEx(WH_KEYBOARD_LL, @LLKeyboardProc, HInstance, 0);
  LLMouseProc:= @MouseProc;
  MHook:= SetWindowsHookEx(WH_MOUSE_LL, @LLMouseProc, HInstance, 0);
end;

procedure UninstallInputHooks;
begin
  if KHook <> 0 then begin UnhookWindowsHookEx(KHook); KHook:= 0; end;
  if MHook <> 0 then begin UnhookWindowsHookEx(MHook); MHook:= 0; end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 InstallInputHooks;
 TrueLastInput:= GetTickCount;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 UninstallInputHooks;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var T0, TD, Tsecs, Tmins: DWORD;
begin
  T0:= GetTickCount;
  TD:= T0 - TrueLastInput;
  Tsecs:= TD div 1000;
  Tmins:= Tsecs div 60;
  panel2.caption := 'T0='+IntToStr(T0)+'  T1='+IntToStr(TrueLastInput)+'  TD='+IntToStr(TD)+'  secs='+IntToStr(Tsecs)+'  mins='+IntToStr(Tmins);
end;

end.

delphi 如何获得系统的真实空闲时间？

1条答案

相关问题

热门标签

最新问答