为什么这个例子总是调试不成功?
如何检测用户多长时间没有鼠标与键盘操作?
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.
