当用户 locks/unlocks 在 Windows 7 中使用 Delphi 屏幕时检测

Question

如何检测用户 locks/unlocks 屏幕在 Windows 7 时？

我发现 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) 可以完成这项工作。这是我试过的代码，但没有用：

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';

执行FormCreate时，WTSRegisterSessionNotificationreturnsfalse和最后OS错误returnsInvalid Parameter.

Answer 1

您的代码无法运行，因为您没有正确实现它。

您没有正确声明 WTSRegisterSessionNotification() 和 WTSUnRegisterSessionNotification()。

此外，您没有考虑 VCL 在 Form 对象的生命周期内动态重新创建 Form 的 window 的可能性。因此，即使 WTSRegisterSessionNotification() 成功了，您也可能会丢失您的注册而没有意识到。

试试这个：

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 = [=10=];
  NOTIFY_FOR_ALL_SESSIONS = ;

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.

也就是说，考虑编写不依赖于 VCL 的 window 娱乐行为的代码。您可以分配一个专用的 window 来监视会话更改：

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 = [=11=];
  NOTIFY_FOR_ALL_SESSIONS = ;

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.

当用户 locks/unlocks 在 Windows 7 中使用 Delphi 屏幕时检测

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

windows

delphi

winapi

delphi-2009