如何檢測用戶多長時間沒有鼠標與鍵盤操做?
如何檢測用戶多長時間沒有鼠標與鍵盤操做? 就像屏保同樣.
個人程序要實現用戶在設定的時間內沒有操做,就自動鎖定程序.
------解決方案--------------------
用鍵盤和鼠標鉤子就好了!
------解決方案--------------------
贊成樓上
------解決方案--------------------
procedure TForm1.Timer1Timer(Sender: TObject);
var
vLastInputInfo: TLastInputInfo;
begin
vLastInputInfo.cbSize := SizeOf(TLastInputInfo);
GetLastInputInfo(vLastInputInfo);
Caption := Format( '用戶已經%d秒沒有動鍵盤鼠標了 ',
[(GetTickCount - vLastInputInfo.dwTime) div 1000]);
end;
------解決方案--------------------
小弟佩服!
------解決方案--------------------
mark
------解決方案--------------------
我想大概的思路是看鼠標和鍵盤有沒有發出移動和按下的事件消息吧..
你查查看能不能消息來處理這樣的事件....
------解決方案--------------------
注意GetLastInputInfo在Win2000之後纔有。
------解決方案--------------------
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.
大概是這樣...函數