Solved

Inactivity Timer

Posted on 1997-03-26
13
604 Views
Last Modified: 2010-05-18
I am looking for a way to set up an inactivity timer using Delphi 2 in the same way that win95 does. By this I mean that if no keyboard or mouse events occur for a designated period of time i would like to execute a procedure. The inactivity timer must function accross all currently running apps, that is to say that if i minimize the current form (therefor no mouse or keyboard events occur in the current form) the mouse and keyboard events are still being registered.
0
Comment
Question by:Mdb
  • 8
  • 4
13 Comments
 
LVL 2

Expert Comment

by:javiertb
Comment Utility
You can use a TTimer component.
-Place the TTimer and set enabled property to false
-Set the time interval you want to wait before executing the procedure if nothing happens (by means of Interval property). -Place a disable ttimer instruction in the onkeypress and onmouse down events followed by an enable ttimer in order to restart the period.
-Place the procedure you want to execute in the ontimer event.

Hope this helps
0
 

Author Comment

by:Mdb
Comment Utility
Edited text of question
0
 

Author Comment

by:Mdb
Comment Utility
The answer does not address global mouse and keyboard events. If the focus is switched to a second app running this would register an inactivity period for the 1st app. however the user IS still working on the second app. I need to be able to register system inactivity as opposed to just a single form or app.
0
 

Author Comment

by:Mdb
Comment Utility
This is becoming urgent, So i have increased the points. Will anyone answer today?????
0
 
LVL 3

Accepted Solution

by:
sperling earned 180 total points
Comment Utility
Look up SetWindowsHookEx

Install a Mouse and a Keyboard hook. Don't do anything with the messages, just set a variable to the value of GetTickCount and pass the message on to the next hook.

Use a timer with a resolution of e.g. 5 sec, in the OnTimer event test (using GetTickCount) how long its been since a mouse or keyboard event occurred.

This will effectively allow you to decide when a computer has been unused for any given amount of time.

If you get inm trouble writing the code, increase the points a bit and I'll write you a unit.


Regards,

Erik.

0
 

Author Comment

by:Mdb
Comment Utility
I don't have much experiance with hooks and would appreciate an example. I ave increased the points. thanks.
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 3

Expert Comment

by:sperling
Comment Utility
Okie.

Here's two files. Source for a TIdleTrigger component, and source for an accompanying DLL.

I haven't tested this on Win 95, only on NT. Let me know if you get trouble.

Create the IDLEDLL.DLL first, and place the DLL in system directory. System-wide hooks *must* reside in a DLL.

Then, install the 'Idle' unit in your component library, and add a TIdleTrigger to a form.

Usage ought to easy enough. If you get trouble, leave me a comment.


----File : IDLE.PAS----
unit Idle;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

type
  TIdleTrigger = class (TComponent)
  private
  protected
    FActive            : BOOLEAN;
    FOnTimeout         : TNotifyEvent;
    FIdleTime          : INTEGER;
    FCheckInterval     : INTEGER;
    FTimer             : TTimer;
    procedure SetIdleTime (value : INTEGER);
    procedure SetCheckInterval (value : INTEGER);
    procedure SetActive (value : BOOLEAN);
  public
    constructor Create (AOwner : TComponent); override;
    destructor  Destroy; override;
    procedure   Loaded; override;
    procedure   CheckTimer (Sender : TObject);
  published
    property  Active : BOOLEAN read FActive write SetActive;
    property  CheckInterval : INTEGER read FCheckInterval write SetCheckInterval;
    property  IdleTime : INTEGER read FIdleTime write SetIdleTime;
    property  OnTimeout : TNotifyEvent read FOnTimeout write FOnTimeout;
  end;

procedure Register;

implementation
var
  FDLL                 : INTEGER;
  FInUse               : BOOLEAN;
  EnableHooks,
  DisableHooks         : procedure; stdcall;
  GetLastActivityTime  : function : INTEGER; stdcall;

procedure Register;
begin
  RegisterComponents('Samples', [TIdleTrigger]);
end;


// OnTimer event
procedure TIdleTrigger.CheckTimer (Sender : TObject);
const
  InProc  : BOOLEAN = FALSE;
begin
  // If CheckTimer (or OnTimeout) is still busy, ignore the timer event
  if InProc then exit;

  try
    // Prevent CheckTimer from being called while it is working
    InProc := TRUE;

    // Check if timeout period has elapsed without activity
    if ((GetTickCount - GetLastActivityTime) DIV 1000) >= FIdleTime then begin

      if Assigned(FOnTimeout)
        // If an event handler is attached, call it
        then FOnTimeout(Self)
        // If not, make an annoying sound ;)
        else MessageBeep(MB_ICONASTERISK);
    end;

  finally
    // And, allow CheckTimer to be called again
    InProc := FALSE;
  end;
end;


procedure TIdleTrigger.SetIdleTime (value : INTEGER);
begin
  // Sanity check on idle timeout.
  if value > 10
    then FIdleTime := value;
end;

procedure TIdleTrigger.SetCheckInterval (value : INTEGER);
begin
  // Sanity check on checking intervalk
  if (value<1) then exit;
  // Set the internal var
  FCheckInterval := value;
  // And set the timer interval
  FTimer.Interval := CheckInterval * 1000;
end;

procedure TIdleTrigger.SetActive (value : BOOLEAN);
begin
  // Standard check, ignore setting to current value
  if value=FActive then exit;
  // Set internal var
  FActive := value;
  // If we're not in the designer and the form is not reading its components,
  // we can enable/disable the hooks
  // Won't work anyway while designing
  if (ComponentState * [csReading, csDesigning] = []) then begin
    if FActive then begin
      // Tell the DLL to install hooks
      EnableHooks;
    end else begin
      // Tell the DLL to remove hooks
      DisableHooks;
    end;
    // And, enable/disable the timer.
    FTimer.Enabled := FActive;
  end;
end;

constructor TIdleTrigger.Create (AOwner : TComponent);
begin
  inherited Create(AOwner);
  // This component will not behave very good if more than one is added
  if FInUse then raise Exception.Create('Cannot include more than one IdleTrigger in an application.');
  // Get the DLL with the hook functions
  FDLL := LoadLibrary('IDLEDLL.DLL');
  // And validate the DLL exists
  if FDLL=0 then raise Exception.Create('IDLEDLL.DLL not found.');
  // Get the exported DLL procs
  DisableHooks := GetProcAddress(FDLL, 'DisableHooks');
  EnableHooks := GetProcAddress(FDLL, 'EnableHooks');
  GetLastActivityTime := GetProcAddress(FDLL, 'GetLastActivityTime');
  // And validate that they exists
  if (@DisableHooks=nil) or (@EnableHooks=nil) or (@GetLastActivityTime=nil) then begin
    FreeLibrary(FDLL);
    FDLL := 0;
    @DisableHooks := nil;
    @EnableHooks := nil;
    @GetLastActivityTime := nil;
    raise Exception.Create('Invalid version of IDLEDLL.DLL');
  end;

  // Indicate a IdleTrigger has been created
  FInUse := TRUE;

  // Set some defaults
  FIdleTime := 30;
  FCheckInterval := 5;

  // And create the timer
  FTimer := TTimer.Create(Self);
  FTimer.OnTimer := CheckTimer;
  FTimer.Enabled := FALSE;
end;

destructor  TIdleTrigger.Destroy;
begin
  // Disable if we're already active
  Active := FALSE;
  // Kill the timer
  FTimer.Free;
  // Unload the DLL and reset variables
  FreeLibrary(FDLL);
  FDLL := 0;
  @DisableHooks := nil;
  @EnableHooks := nil;
  @GetLastActivityTime := nil;
  // And indicate no IdleTriggers exists
  FInUse := FALSE;
  inherited Destroy;
end;

procedure   TIdleTrigger.Loaded;
begin
  // Form has finished reading components, now we can enable the
  // trigger if Active was true in Object Inspector
  if FActive then begin
    FActive := FALSE;
    Active := TRUE;
  end;
end;


initialization
  // Reset vars. D2 compiler is a bit buggy and dosn't always reset global vars
  FInUse := FALSE;
  FDLL := 0;
finalization
  // Make sure the hooks are removed, and the DLL unloaded properly
  if @DisableHooks<>nil then DisableHooks;
  if FDLL<>0 then FreeLibrary(FDLL);
  // Reset variables, just in case app termination fails
  FDLL := 0;
  @DisableHooks := nil;
  @EnableHooks := nil;
  @GetLastActivityTime := nil;
end.
--------------------------


----File : IDLEDLL.DPR----
library IDLEDLL;

uses
  Windows;

var
  FMouseHook,
  FKeyboardHook,
  FLastActivity   : INTEGER;

// Hook procedure. Record time and call next hook.
function MouseHook (nCode : INTEGER; wParam : WORD; lParam : INTEGER) : INTEGER; stdcall;
begin
  Result := CallNextHookEx(FMouseHook, nCode, wParam, lParam);
  FLastActivity := GetTickCount;
end;

// Hook procedure. Record time and call next hook.
function KeyboardHook (nCode : INTEGER; wParam : WORD; lParam : INTEGER) : INTEGER; stdcall;
begin
  Result := CallNextHookEx(FKeyboardHook, nCode, wParam, lParam);
  FLastActivity := GetTickCount;
end;

// Install the hooks if they ain't already
procedure EnableHooks; stdcall; export;
begin
  if FMouseHook<>0 then exit;
  FMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHook, hInstance, 0);
  FKeyboardHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHook, hInstance, 0);
  FLastActivity := GetTickCount;
end;

// Remove the hooks if they're active
procedure DisableHooks; stdcall; export;
begin
  UnhookWindowsHookEx(FMouseHook);
  UnhookWindowsHookEx(FKeyboardHook);
end;

// Return the last recorded time
function  GetLastActivityTime : INTEGER; stdcall; export;
begin
  Result := FLastActivity;
end;

exports
  EnableHooks,
  DisableHooks,
  GetLastActivityTime;

begin
end.
--------------------------



Hope this'll help you out.

Regards,

Erik.
0
 

Author Comment

by:Mdb
Comment Utility
Hi,

I finally got to implement the code above, and on the surface it seemed to work, however there does seem to be a problem which i am hoping you might be able to shed some light on. The idle timer seemes to work while the delphi app containing (and loading the dll) has the focus, however if i launch a third part app (like say netscape) the idle timer seems to fire at the specified intereval. It is almost as if the idledll does not receive mouse or keyboard events unless  my app has the focus. I need help getting this working so that the mouse and keyboard events are monitored even when my app does not have the focus. If you like i can open a new question with ALL (300) my points. please advise.

Thanks
0
 
LVL 3

Expert Comment

by:sperling
Comment Utility
Whoops... Sorry. I just plain forgot something rather important, namely that DLLs don't share their data in between processes. I'll fix the DLL and post the code here in a day or two.

Regards,

Erik.


0
 

Author Comment

by:Mdb
Comment Utility
I appreciate it, it is becoming rather urgent so i would be only too glad to open a new question if you like.

Let me know.

Thanks
0
 

Author Comment

by:Mdb
Comment Utility
Sorry to keep bugging you, I am getting a little desperate for a soloution to this problem as i have already rolled it out into our production environment. I would appreciate a pointer as to where i might start looking for ann answer if you don't have the time right now to modify the dll.

Thanks in advance.
0
 
LVL 3

Expert Comment

by:sperling
Comment Utility
Here you go. Modified the DLL to store hook handles and last activity time in a shared memory area.

Sorry I'm slow, been quite busy negotiating terms for a project the last few days...

Regards,

Erik.

----
library IDLEDLL;

uses
  Windows;

type
  PSharedData = ^TSharedData;
  TSharedData =
    record
      MouseHook,
      KeyboardHook,
      LastActivity   : INTEGER;
    end;

var
  FData : PSharedData;
  FMap  : INTEGER;

// Hook procedure. Record time and call next hook.
function MouseHook (nCode : INTEGER; wParam : WORD; lParam : INTEGER) : INTEGER; stdcall;
begin
  Result := CallNextHookEx(FData^.MouseHook, nCode, wParam, lParam);
  FData^.LastActivity := GetTickCount;
end;

// Hook procedure. Record time and call next hook.
function KeyboardHook (nCode : INTEGER; wParam : WORD; lParam : INTEGER) : INTEGER; stdcall;
begin
  Result := CallNextHookEx(FData^.KeyboardHook, nCode, wParam, lParam);
  FData^.LastActivity := GetTickCount;
end;

// Install the hooks if they ain't already
procedure EnableHooks; stdcall; export;
begin
  if FData^.MouseHook<>0 then exit;
  FData^.MouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHook, hInstance, 0);
  FData^.KeyboardHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHook, hInstance, 0);
  FData^.LastActivity := GetTickCount;
end;

// Remove the hooks if they're active
procedure DisableHooks; stdcall; export;
begin
  UnhookWindowsHookEx(FData^.MouseHook);
  UnhookWindowsHookEx(FData^.KeyboardHook);
end;

// Return the last recorded time
function  GetLastActivityTime : INTEGER; stdcall; export;
begin
  Result := FData^.LastActivity;
end;


// DLL Entry point.
procedure DLLMain(Reason : INTEGER);
begin
  if Reason = 1 then begin
    // Process attachment.
    FMap := CreateFileMapping(-1, nil, PAGE_READWRITE, 0, SizeOf(TSharedData), 'KBDHOOK');
    FData := MapViewOfFile(FMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  end else if Reason = 0 then begin
    // Process detachment
    UnmapViewOfFile(FData);
    CloseHandle(FMap);
  end;
end;


exports
  EnableHooks,
  DisableHooks,
  GetLastActivityTime;

begin
  DLLProc := @DLLMain;
  DLLMain(1);
end.

0
 

Author Comment

by:Mdb
Comment Utility
Great!

Much appreciated, I tested it and it works like a dream. Thanks for your help.

Good luck on your project!

0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now