讨论：如何判断在规定的时间内，用户无动作（没有鼠标键盘等）

Question

和winOS的屏保一样，在一段时间内用户没有按键或活动鼠标等就锁定用户程序。怎样实现效率较高？

Answer 1

用定时器,当有按键或活动鼠标时(对你的应用程序.用可OnKeyPress及OnMouseMove/OnMouseDown
事件),开定时器,达到设定时间就锁定用户程序
如果中间有按键或活动鼠标时,复位定时器就可以了

Answer 2

这太麻烦，如果有N表单，M控件每一个都得写最少KEYUPKEYDOWNKEYPREESSMOUSEMOVEMOUSEDOWN等等应该有更好的方法。

Answer 3

如果是这样,可用application的消息处理,如Application.OnMessage 
当Application 处理WM_KEYDOWN,WM_MOUSEMOVE ...等消息时,开定时器

Answer 4

思路：
1、在Form内设置一个全局变量，用以控制时间；
var
  WaitTime: integer;
2、设置一个Timer控件，在事件内
  inc(WaitTime);
3、挡截Windows消息；
  //键盘消息
  procedure KillWaitTime(var msg: TMessage); message WM_KEYDOWN;
  begin
    WaitTime := 0;
  end;
  //鼠标消息
  省
{  当然也可以在Form事件中的KeyDown, MouseMove中WaitTime := 0;}

Answer 5

//------------給你一個麻子老大寫的程序----------
//-----------轉帖，版權歸"liumazi"所有----------
//---------------程序使用了鉤子-----------------
//--如果你使用此代碼，請注明原作者“Liumazl”---
program UseHook;
//-----按 Icon.txt 生成 icon.Res 編譯到exe中---------
{$R    '..\Icon\icon.Res'  '..\Icon\Icon.txt' }uses
  Windows,ShellAPI;const
  ClassName       = 'LiuMaZi'; //窗體類名
  WindowsName     = 'LoveLiuMazi';//窗體標題
  WM_COMMAND      = $0111;  //單擊菜單項消息
  WM_LBUTTONDOWN  = $0201;  //鼠標左鍵單擊消息
  WM_TIMER        = $0113;  //計時器函數
  WM_KEYFIRST     = $0100;  //第一個鍵盤消息
  WM_KEYLAST      = $0108;  //最後一個鍵盤消息
  WM_MOUSEFIRST   = $0200;  //第一個鼠標消息
  WM_MOUSELAST    = $020A;  //最後一個鼠標消息
  WM_MyTray       = $0800;  //自定義消息，用於響應托盤操作var
  MyMessage : TMsg;            //消息結構
  WinClass  : TWndClass;       //窗體類結構
  WinHandle : hWnd;            //窗體句柄
  PopupMenu : hMenu;           //菜單句柄
  MousePos  : TPoint;          //鼠標位置
  IconData  : TNotifyIconData; //托盤結構
  Count     : integer;         //累計經過的時間
  state     : Boolean=True;         //當前狀態，True為在線，False為離開
  NextHook  : LongWord; //-----------窗體消息處理過程，回調函數-------
function WndProc(WinH : hWnd; WinMsg,WParam,LParam : Longint): Integer; StdCall;
Begin
  Result := 0;
  Case WinMsg of
 //預定時間到
    WM_TIMER  :begin
                 if state=True then
                 begin
                   Count:=Count+1;
                   {5秒後"離開"}
                   if Count=5 then
                   begin
                   //換托盤圖標為離開
                     IconData.HIcon:=LoadIcon(hInstance,'Icon2');
                     IconData.UFlags:=NIF_ICON ;
                     Shell_NotifyIcon(NIM_MODIFY,@IconData);
                   //置當前狀態為離開
                     state:=False;
                   end;
                 end;
               end;
 //鼠標單擊菜單
    WM_COMMAND:begin {菜單項ID}
                  case WParam of
                   {關於}
                   1:  MessageBox(0,'劉瀏   QQ  : 71892967'+#13+
                                  'http://Liumazi.efile.com.cn/'+#13+
                                  'MSN: [email protected] ',
                                  '象MSN那樣判斷用戶離開',MB_OK);
                   {退出}
                    2: PostQuitMessage(0);//給線程消息隊列送WM_QUIT退出消息
                   end;
               end;
 //操作托盤圖標
    WM_MyTray :begin           {鼠標左鍵}
                 if (LParam = WM_LBUTTONDOWN) Then
                 begin
                  //在鼠標當前位置處彈出菜單
                   SetForegroundWindow(WinHandle);
                   GetCursorPos(MousePos);
                   TrackPopupMenu(PopupMenu,tpm_LeftAlign Or tpm_LeftButton,
                                    MousePos.X,MousePos.Y,0,WinHandle,nil);
                 end;
               end;
//其他消息調用默認消息處理過程
    else Result := DefWindowProc(WinH,WinMsg,WParam,LParam);
  end;
end;
//-------鉤子回調函數---(有消息時候該函數將被調用)-----------------
function HookProc( iCode:Integer; wParam:WPARAM; lParam:LPARAM ):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(NextHook,iCode,wParam,lParam);
          //鍵盤消息
  if ( (PEventMsg(lparam)^.message>=WM_KEYFIRST)and
     (PEventMsg(lparam)^.message<=WM_KEYLAST) ) or
          //鼠標消息
     ( (PEventMsg(lparam)^.message>=WM_MOUSEFIRST)and
     (PEventMsg(lparam)^.message<=WM_MOUSELAST) )then
     begin
       Count:=0;
       if state=false then
       begin
     //換托盤圖標為離開
         IconData.HIcon:=LoadIcon(hInstance,'Icon1');
         IconData.UFlags:=NIF_ICON ;
         Shell_NotifyIcon(NIM_MODIFY,@IconData);
     //置當前狀態為在線
         state:=True;
       end;
     end;
 end;//----------------主程序------------------
begin //找到則說明已有一個實例運行
  if findwindow(Pchar(ClassName),Pchar(WindowsName))<>0 then
    MessageBox(0,'程序已運行.....^_^  ','',MB_OK)
  else
  begin
 //填充窗體類結構體
    With WinClass do
    Begin
      Style       := 0;          {類風格}
      lpfnWndProc := @WndProc;   {窗口過程}
      cbClsExtra  := 0;          {額外類信息}
      cbWndExtra  := 0;          {額外窗口信息}
      hIcon   := 0;              {圖標}
      hCursor := 0;              {光標}
      hbrBackground := 0;        {顏色}
      lpszMenuName  := nil;      {菜單}
      lpszClassName := ClassName;{類名稱}
      hInstance:=GetModuleHandle(nil);{實例句柄}
    end;
  //註冊窗體類
    RegisterClass(WinClass);
  //建立一個窗體（不可見）  
    WinHandle :=CreateWindowEx(0,ClassName,WindowsName,
                              ws_OverlappedWindow,0,0,
                              0,0,0,0,hInstance,nil);
  //建立菜單
    PopupMenu := CreatePopupMenu;
  //依次添加菜單項
    AppendMenu(PopupMenu,mf_Enabled  Or mf_String,1,'&Abort');
    AppendMenu(PopupMenu,mf_Enabled Or mf_String,2,'E&xit');
  //填充托盤結構體
    With IconData do
    begin
      cbSize := SizeOf(IconData);
      Wnd :=WinHandle;  //指定所屬窗體
      uID := 100;
      uFlags := nif_Icon Or nif_Message Or nif_Tip;
      uCallBackMessage := WM_MyTray;           //指定消息ID
      hIcon := LoadIcon(hInstance,'Icon1'); //指定托盤圖標
      szTip :='象MSN那樣'+#13+'判斷用戶是否離開     '+#13+'Coder : 劉麻子 ';
    end;
  //添加托盤到系統任務欄
    Shell_NotifyIcon(nim_Add,@IconData);
  //創建定時器
    SetTimer(WinHandle,1,1000,NIL);
  //掛消息鉤子
    NextHook:=SetWindowsHookEx(WH_JOURNALRECORD, HookProc,HInstance,0);
//====消息循環==開始===========
          {此函數從消息隊列取消息，遇WM_QUIT返回Fasle，從而導致循環結束}
          {如果隊列內沒消息，則當前線程掛起，直到有消息進入隊列}
    While GetMessage(MyMessage,0,0,0) do
      DispatchMessage(MyMessage);//分發消息到相應窗體消息處理過程
//====消息循環==結束===========//卸載鉤子  
   UnHookWindowsHookEx(NextHook);
//刪除定時器
    KillTimer(WinHandle,1);
//釋放菜單
    DestroyMenu(PopupMenu);
//釋放托盤
    IconData.cbSize:=0;
    Shell_NotifyIcon(NIM_DELETE,@IconData);
//釋放窗體
    DestroyWindow(WinHandle);
  end;
  
end.

Answer 6

暈！上面的那行寫錯了，
改為：//--如果你使用此代碼，請注明原作者“liumazi”---
//附，原程序下載：http://www.2ccc.com/article.asp?articleid=1264

Answer 7

function cursorstoptime:integer;//返回没有键盘和鼠标事件的时间,以1/1000秒为单位
var
  linput:tlastinputinfo;
begin
  linput.cbSize:=sizeof(tlastinputinfo);
  getlastinputinfo(linput);
  result:=gettickcount()-linput.dwTime;
end;

Answer 8

procedure TTimeOutNotify.ApplicationEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
begin
  //处理键盘、鼠标消息
  if ((Msg.message &gt;= WM_KEYFIRST) and (Msg.message &lt;= WM_KEYLAST)) or
          ((Msg.message &gt;= WM_MOUSEFIRST) and (Msg.message &lt;= WM_MOUSELAST))then
      LastActTime := now;
end;
procedure TTimeOutNotify.TimerTimer(Sender: TObject) ;
begin
  //如果键盘、鼠标在指定的时间内没有消息，调用处理事件
  if SecondsBetween(now,LastActTime) &gt; IdleTimeLimited then Begin
     LastActTime := now;
   end else Begin
      ShowMessage('本程序未活动时间超过'+IntToStr(IdleTimeLimited)+'秒！');
    end;
  end;end;

Answer 9

我是这样写的:
var
procedure Tform1.formcreate(sender:object)
begin
end;

Answer 10

我是这样写的:
var
app_runtime:cardinal;
procedure Tform1.formcreate(sender:object)
begin
  app_runtime :=0;
  timer1.enabled := true; 
  application.onmessage := appmsg;
end;
peocedure tform1.appmsg(var msg:Tmsg;var handled:boolean)
begin
  if ((msg.message>WM_KEYFIRST) and (msg.message<WM_KEYLast)) or
     ((msg.message>WM_MOUSEFIRST) and (msg.message<WM_MOUSELast)) then
  app_runtime:=0;
end;
procedure tform1.timer1timer(sender:object)
begin
  app_runtime:= app_runtime+1;
  if app_runtime = 10000 then close;
end

Answer 11

to xiaocuo_zrf(小错):
   你的applicationeventmessage 也赋给applicat
ion.onmessage了吧.
小错   答复正解

Answer 12

The GetLastInputInfo function retrieves the time of the last input event.SyntaxBOOL GetLastInputInfo(PLASTINPUTINFO plii);Parametersplii
[out] Pointer to a LASTINPUTINFO structure that receives the time of the last input event. 
Return ValueIf the function succeeds, the return value is nonzero.If the function fails, the return value is zero. 
ResThis is useful for input idle detection.Function InformationMinimum DLL Version user32.dll 
Header Declared in Winuser.h, include Windows.h 
Import library User32.lib 
Minimum operating systems Windows 2000 

Answer 13

楼上的GetLastInputInfo才是正解!!

Answer 14

关键是使用 WH_JOURNALRECORD 钩子
看看 BCB 写的例子
http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=181808

Answer 15

用GetLastInputInfo-当前时间就可以了，我的程序就是这么做的，根本用不着什么hook

Answer 16

呵呵，以下是我作的模型，当然如果使用GetLastInputInfo当然好，但是如果只针对某个程序的延时控制我到觉得这个模型比较合适。
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AppEvnts, ExtCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    ApplicationEvents1: TApplicationEvents;
    Timer1: TTimer;
    Memo1: TMemo;
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}
const
  LOCKTIME=6000;//1000 millisecondsprocedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  case Msg.message of
    WM_LBUTTONDOWN,WM_MBUTTONDOWN,WM_MOUSEMOVE,
    WM_RBUTTONDOWN,WM_MOUSEWHEEL,WM_KEYDOWN:Tag:=GetTickCount;
  end;
end;procedure TForm1.FormShow(Sender: TObject);
begin
  Tag:=GetTickCount;
  Timer1.Interval:=1;
  Timer1.Enabled:=True;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if GetTickCount-Tag>LOCKTIME then Memo1.Lines.Add('Locked!');
end;end.