【转】怎么检测用户多长时间没有鼠标与键盘操作

var 
Form1: TForm1; 
RecordHook: HHOOK; // 钩子句柄 
Timer: Integer = 0; // 累计时间, 秒为单位 
State: Boolean = TRUE; // 是否 '在线 ' 
//========= 
Msg: TMsg; 
WndClass: TWndClass; 
HMainWnd: HWND; 
implementation 

{$R *.dfm} 
// 窗体函数 
function WindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 
var 
MousePos: TPoint; // 鼠标位置 
begin 
case (uMsg) of 
WM_TIMER: 
if (State = TRUE) then 
begin 
Inc(Timer); 
if (Timer > = 5) then // 超过5秒认为离开 
begin 
State := FALSE; 
form1.Button1.Caption:= '离开了 '; 
end; 
end; 
end; 
Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
end; 

// 钩子函数 
function JournalRecordProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 
var 
Msg: LongWord; 
begin 
if (nCode = HC_ACTION) then // lParam 指向消息结构 
begin 
Msg := PEventMsg(lParam)^.message; 
if ( (Msg > = WM_KEYFIRST) and (Msg <= WM_KEYLAST) ) or // 键盘消息 
( (Msg > = WM_MOUSEFIRST) and (Msg <= WM_MOUSELAST) ) then // 鼠标消息 
begin 
Timer := 0; 
if (State = FALSE) then // '离开 ' -> '在线 ' 
begin 
State := TRUE; 
form1.Button1.Caption:= '回来了 '; 
end; 
end; 
end; 
Result := CallNextHookEx(RecordHook, nCode, wParam, lParam); // 下一个钩子 
end; 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
// 卸载钩子 
UnHookWindowsHookEx(RecordHook); 
// 删除时钟 
KillTimer(HMainWnd, 6); 
end; 

procedure TForm1.FormShow(Sender: TObject); 
begin 
// 安装时钟 
SetTimer(HMainWnd, 6, 1000, nil); 

// 安装钩子 
RecordHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalRecordProc, HInstance, 0); 

// 消息循环 
while GetMessage(Msg, 0, 0, 0) do 
begin 
if (Msg.message = WM_CANCELJOURNAL) then // 此时需要重新挂钩 
RecordHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalRecordProc, HInstance, 0) 
else 
DispatchMessage(Msg); 
end; 
end; 

end. 

原文地址

群友 DUP发给我的，这里先谢了！

var

  vLastInputInfo: TLastInputInfo;

  vOverTime:Integer;

begin

  vLastInputInfo.cbSize := SizeOf(vLastInputInfo);

  GetLastInputInfo(vLastInputInfo);

  vOverTime:=GetTickCount - vLastInputInfo.dwTime;

  if  vOverTime>2*60000 then //2分种不操作返回主界面  20000

  begin

   tlcntrlMain.ActiveDetail:=nil;

   lblTopRight.Caption:='';

  end

  else

  begin

    if (vOverTime>=110000) and (tlcntrlMain.ActiveDetail<>nil) then  // 10000

    begin

      if lblTopRight.Caption='' then

       lblTopRight.Caption:='10'

     else

     begin

      lblTopRight.Caption:=IntToStr(StrToInt(lblTopRight.Caption)-1);

     end;

    end;

  end;

  if vOverTime<1000 then

   lblTopRight.Caption:='';

end;
//试了DUP群友给的这段代码，是全局检测是否有键鼠操作，而不是我想像中只检测当前运行的应用。（在Win10+Delphi 10.1环境下测试，在XP上也进行测试，正常检测到了）。

竹子给我的一段代码，测试达到只检测当前应用是否无用户操作的目的，这个是我想要的效果，多谢了。测试环境：Delphi7+winxp,Berlin+win10.

unit Unit17;

interface

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

type
  TForm17 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure IdleMessage(var pMsg: TMsg; var pHandled: Boolean);
    { Private declarations }
  public
    ActiveTime: Cardinal;
    { Public declarations }
  end;

var
  Form17: TForm17;

implementation

{$R *.dfm}

procedure TForm17.FormCreate(Sender: TObject);
begin
  ActiveTime := GetTickCount;
  Application.OnMessage := IdleMessage;
end;

Procedure TForm17.IdleMessage(Var pMsg: TMsg; Var pHandled: Boolean);
Begin
  Case pMsg.message Of
   WM_MouseMove:
     ActiveTime := GetTickCount;
   WM_LBUTTONDOWN:
     ActiveTime := GetTickCount;
   WM_RBUTTONDOWN:
     ActiveTime := GetTickCount;
   WM_MOUSEWHEEL:
     ActiveTime := GetTickCount;
   WM_KeyDown:
     ActiveTime := GetTickCount;
   WM_Char:
     ActiveTime := GetTickCount;
  End;
End;

procedure TForm17.Timer1Timer(Sender: TObject);
Var
  iIdleLeftTime: Cardinal;
Begin
  iIdleLeftTime := (GetTickCount - ActiveTime) div 1000;

  if iIdleLeftTime > 0 then
   Memo1.Lines.Add('iIdleLeftTime = ' + iIdleLeftTime.ToString + '秒无操作...');

End;

end.