Detect when user locks/unlocks screen in Windows 7 with Delphi

Question

How to detect when the user locks/unlocks the screen in Windows 7?

I found this question which has an answer for C#, but I'd like to use it in Delphi 2009. I'd guess there is some windows message (like these) which could do the work. This is the code I tried, but it didn't work:

const
  NOTIFY_FOR_ALL_SESSIONS = 1;
  {$EXTERNALSYM NOTIFY_FOR_ALL_SESSIONS}
  NOTIFY_FOR_THIS_SESSION = 0;
  {$EXTERNALSYM NOTIFY_FOR_THIS_SESSION}

type

TfrmAlisson = class(TForm)
  lbl2: TLabel;
  procedure FormCreate(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
public
  FLockedCount: Integer;
  procedure WndProc(var Message: TMessage); override;
  function WTSRegisterSessionNotification(hWnd: HWND; dwFlags: DWORD): bool; stdcall;
  function WTSUnRegisterSessionNotification(hWND: HWND): bool; stdcall;
end;

implementation

uses
  // my impl uses here

procedure TfrmAlisson.FormCreate(Sender: TObject);
begin
  if (WTSRegisterSessionNotification(Handle, NOTIFY_FOR_THIS_SESSION)) then
    ShowMessage('Nice')
  else
  begin
    lastError := GetLastError;
    ShowMessage(SysErrorMessage(lastError));
  end;
end;

procedure TfrmAlisson.FormDestroy(Sender: TObject);
begin
  WTSUnRegisterSessionNotification(Handle);
end;

procedure TfrmAlisson.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_WTSSESSION_CHANGE:
      begin
        if Message.wParam = WTS_SESSION_LOCK then
        begin
          Inc(FLockedCount);
        end;
        if Message.wParam = WTS_SESSION_UNLOCK then
        begin
          lbl2.Caption := 'Session was locked ' +
          IntToStr(FLockedCount) + ' times.';
        end;
      end;
  end;
  inherited;
end;

function TfrmAlisson.WTSRegisterSessionNotification(hWnd: HWND; dwFlags: DWORD): bool;
  external 'wtsapi32.dll' Name 'WTSRegisterSessionNotification';

function TfrmAlisson.WTSUnRegisterSessionNotification(hWND: HWND): bool;
  external 'wtsapi32.dll' Name 'WTSUnRegisterSessionNotification';

When FormCreate executes, WTSRegisterSessionNotification returns false and the last OS error returns Invalid Parameter.

Answer 1

Your code does not work because you did not implement it correctly.

You are not declaring WTSRegisterSessionNotification() and WTSUnRegisterSessionNotification() correctly.

Also, you are not accounting for the possibility of the VCL ever recreating the Form's window dynamically during the Form object's lifetime. So, even if WTSRegisterSessionNotification() were successful, you can lose your registration and not realize it.

Try this instead:

interface

uses
  ...;

type
  TfrmAlisson = class(TForm)
    lbl2: TLabel;
  protected
    procedure CreateWnd; override;
    procedure DestroyWindowHandle; override;
    procedure WndProc(var Message: TMessage); override;
  public
    LockedCount: Integer;
  end;

implementation

const
  NOTIFY_FOR_THIS_SESSION = $0;
  NOTIFY_FOR_ALL_SESSIONS = $1;

function WTSRegisterSessionNotification(hWnd: HWND; dwFlags: DWORD): Boolean; stdcall; external 'wtsapi32.dll' name 'WTSRegisterSessionNotification';
function WTSUnRegisterSessionNotification(hWnd: HWND): Boolean; stdcall; external 'wtsapi32.dll' name 'WTSUnRegisterSessionNotification';

procedure TfrmAlisson.CreateWnd;
begin
  inherited;
  if not WTSRegisterSessionNotification(Handle, NOTIFY_FOR_THIS_SESSION) then
    RaiseLastOSError;
end;

procedure TfrmAlisson.DestroyWindowHandle;
begin
  WTSUnRegisterSessionNotification(Handle);
  inherited;
end;

procedure TfrmAlisson.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_WTSSESSION_CHANGE then
  begin
    case Message.wParam of
      WTS_SESSION_LOCK: begin
        Inc(LockedCount);
      end;
      WTS_SESSION_UNLOCK: begin
        lbl2.Caption := Format('Session was locked %d times.', [LockedCount]);
      end;
    end;
  end;
  inherited;
end;

end.

---

That being said, consider writing the code to not rely on the VCL's window recreation behavior. You can allocate a dedicated window for monitoring the session changes:

interface

uses
  ...;

type
  TfrmAlisson = class(TForm)
    lbl2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    SessionWnd: HWND;
    procedure SessionWndProc(var Message: TMessage);
  public
    LockedCount: Integer;
  end;

implementation

const
  NOTIFY_FOR_THIS_SESSION = $0;
  NOTIFY_FOR_ALL_SESSIONS = $1;

function WTSRegisterSessionNotification(hWnd: HWND; dwFlags: DWORD): Boolean; stdcall; external 'wtsapi32.dll' name 'WTSRegisterSessionNotification';
function WTSUnRegisterSessionNotification(hWnd: HWND): Boolean; stdcall; external 'wtsapi32.dll' name 'WTSUnRegisterSessionNotification';

procedure TfrmAlisson.FormCreate(Sender: TObject);
begin
  SessionWnd := AllocateHWnd(SessionWndProc);
  if not WTSRegisterSessionNotification(SessionWnd, NOTIFY_FOR_THIS_SESSION) then
    RaiseLastOSError;
end;

procedure TfrmAlisson.FormDestroy(Sender: TObject);
begin
  if SessionWnd <> 0 then
  begin
    WTSUnRegisterSessionNotification(SessionWnd);
    DeallocateHWnd(SessionWnd);
  end;
end;

procedure TfrmAlisson.SessionWndProc(var Message: TMessage);
begin
  if Message.Msg = WM_WTSSESSION_CHANGE then
  begin
    case Message.wParam of
      WTS_SESSION_LOCK: begin
        Inc(LockedCount);
      end;
      WTS_SESSION_UNLOCK: begin
        lbl2.Caption := Format('Session was locked %d times.', [LockedCount]);
      end;
    end;
  end;

  Message.Result := DefWindowProc(SessionWnd, Message.Msg, Message.WParam, Message.LParam);
end;

end.