Détecter quand l’utilisateur verrouille / déverrouille l’écran dans Windows 7 avec Delphi

Comment détecter lorsque l’utilisateur verrouille / déverrouille l’écran dans Windows 7?

J’ai trouvé cette question qui a une réponse pour C #, mais je voudrais l’utiliser dans Delphi 2009. Je suppose qu’il existe des messages Windows (comme ceux-ci ) qui pourraient faire l’affaire. C’est le code que j’ai essayé, mais ça n’a pas fonctionné:

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

Lorsque FormCreate exécuté, WTSRegisterSessionNotification renvoie false et la dernière erreur du système d’exploitation renvoie le paramètre non valide .

Votre code ne fonctionne pas car vous ne l’avez pas implémenté correctement.

Vous ne WTSRegisterSessionNotification() pas WTSRegisterSessionNotification() et WTSUnRegisterSessionNotification() correctement.

En outre, vous ne tenez pas compte de la possibilité que la VCL recrée dynamicment la fenêtre du formulaire pendant la durée de vie de l’object. Donc, même si WTSRegisterSessionNotification() réussi, vous pouvez perdre votre enregistrement et ne pas le réaliser.

Essayez plutôt ceci:

 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. 

Cela étant dit, envisagez d’écrire le code pour ne pas vous fier au comportement de recréation de fenêtre de la VCL. Vous pouvez allouer une fenêtre dédiée pour surveiller les modifications de session:

 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.