Windows 10 Logon / Logoff erkennen

[Corsair_ML]

Hallo,

ich lese schon lange im Forum mit und konnte so viele Probleme lösen. Diesmal komme ich aber nicht weiter. Ich programmiere als Hobby mit Delphi 6 Professional unter Windows XP in VirtualBox.

Ich bin dabei mir eine Stechuhr für das Home Office zu erstellen. Dabei möchte ich, dass beim Sperren von Windows 10 die Zeit bis zum Entsperren gestoppt wird. Diese Zeit nutze ich als Pause. Ich habe aber beim Erkennen, dass Windows gesperrt bzw. entsperrt Probleme. Durch Recherche bin ich auf folgende Lösung gekommen (siehe auch hier https://www.swissdelphicenter.ch/en/...de.php?id=1109 ):

Code:

unit Wtsapi;
 
interface
 
 
uses
  Windows;
 
const
  // The WM_WTSSESSION_CHANGE message notifies applications of changes in session state.
  WM_WTSSESSION_CHANGE = $2B1;
 
  // wParam values:
  WTS_CONSOLE_CONNECT = 1;
  WTS_CONSOLE_DISCONNECT = 2;
  WTS_REMOTE_CONNECT = 3;
  WTS_REMOTE_DISCONNECT = 4;
  WTS_SESSION_LOGON = 5;
  WTS_SESSION_LOGOFF = 6;
  WTS_SESSION_LOCK = 7;
  WTS_SESSION_UNLOCK = 8;
  WTS_SESSION_REMOTE_CONTROL = 9;
 
  // Only session notifications involving the session attached to by the window
  // identified by the hWnd parameter value are to be received.
  NOTIFY_FOR_THIS_SESSION = 0;
  // All session notifications are to be received.
  NOTIFY_FOR_ALL_SESSIONS = 1;
 
 
function RegisterSessionNotification(Wnd: HWND; dwFlags: DWORD): Boolean;
function UnRegisterSessionNotification(Wnd: HWND): Boolean;
function GetCurrentSessionID: Integer;
 
implementation
 
function RegisterSessionNotification(Wnd: HWND; dwFlags: DWORD): Boolean;
  // The RegisterSessionNotification function registers the specified window
  // to receive session change notifications.
  // Parameters:
  // hWnd: Handle of the window to receive session change notifications.
  // dwFlags: Specifies which session notifications are to be received:
  // (NOTIFY_FOR_THIS_SESSION, NOTIFY_FOR_ALL_SESSIONS)
type
  TWTSRegisterSessionNotification = function(Wnd: HWND; dwFlags: DWORD): BOOL; stdcall;
var
  hWTSapi32dll: THandle;
  WTSRegisterSessionNotification: TWTSRegisterSessionNotification;
begin
  Result := False;
  hWTSAPI32DLL := LoadLibrary('Wtsapi32.dll');
  if (hWTSAPI32DLL > 0) then
  begin
    try @WTSRegisterSessionNotification :=
        GetProcAddress(hWTSAPI32DLL, 'WTSRegisterSessionNotification');
      if Assigned(WTSRegisterSessionNotification) then
      begin
        Result:= WTSRegisterSessionNotification(Wnd, dwFlags);
      end;
    finally
      if hWTSAPI32DLL > 0 then
        FreeLibrary(hWTSAPI32DLL);
    end;
  end;
end;
 
function UnRegisterSessionNotification(Wnd: HWND): Boolean;
  // The RegisterSessionNotification function unregisters the specified window
  // Parameters:
  // hWnd: Handle to the window
type
  TWTSUnRegisterSessionNotification = function(Wnd: HWND): BOOL; stdcall;
var
  hWTSapi32dll: THandle;
  WTSUnRegisterSessionNotification: TWTSUnRegisterSessionNotification;
begin
  Result := False;
  hWTSAPI32DLL := LoadLibrary('Wtsapi32.dll');
  if (hWTSAPI32DLL > 0) then
  begin
    try @WTSUnRegisterSessionNotification :=
        GetProcAddress(hWTSAPI32DLL, 'WTSUnRegisterSessionNotification');
      if Assigned(WTSUnRegisterSessionNotification) then
      begin
        Result:= WTSUnRegisterSessionNotification(Wnd);
      end;
    finally
      if hWTSAPI32DLL > 0 then
        FreeLibrary(hWTSAPI32DLL);
    end;
  end;
end;
 
function GetCurrentSessionID: Integer;
 // Getting the session id from the current process
type
  TProcessIdToSessionId = function(dwProcessId: DWORD; pSessionId: DWORD): BOOL; stdcall;
var
  ProcessIdToSessionId: TProcessIdToSessionId;
  hWTSapi32dll: THandle;
  Lib : THandle;
  pSessionId : DWord;
begin
  Result := 0;
  Lib := GetModuleHandle('kernel32');
  if Lib <> 0 then
  begin
    ProcessIdToSessionId := GetProcAddress(Lib, '1ProcessIdToSessionId');
    if Assigned(ProcessIdToSessionId) then
    begin
      ProcessIdToSessionId(GetCurrentProcessId(), DWORD(@pSessionId));
      Result:= pSessionId;
    end;
  end;
end;
 
end.

Und die Nutzung im Programm

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Wtsapi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FRegisteredSessionNotification : Boolean;
    procedure AppMessage(var Msg: TMSG; var HAndled: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AppMessage(var Msg: TMSG; var Handled: Boolean);
var
  strReason: string;
begin
  Handled := False;
  Memo1.Lines.Add('AppMessage');
  // Check for WM_WTSSESSION_CHANGE message
  if Msg.Message = WM_WTSSESSION_CHANGE then
  begin
    Memo1.Lines.Add('Message '+IntToStr(Msg.wParam));
     case Msg.wParam of
       WTS_CONSOLE_CONNECT:
           strReason := 'WTS_CONSOLE_CONNECT';
       WTS_CONSOLE_DISCONNECT:
           strReason := 'WTS_CONSOLE_DISCONNECT';
       WTS_REMOTE_CONNECT:
           strReason := 'WTS_REMOTE_CONNECT';
       WTS_REMOTE_DISCONNECT:
           strReason := 'WTS_REMOTE_DISCONNECT';
       WTS_SESSION_LOGON:
           strReason := 'WTS_SESSION_LOGON';
       WTS_SESSION_LOGOFF:
           strReason := 'WTS_SESSION_LOGOFF';
       WTS_SESSION_LOCK:
           strReason := 'WTS_SESSION_LOCK';
       WTS_SESSION_UNLOCK:
           strReason := 'WTS_SESSION_UNLOCK';
       WTS_SESSION_REMOTE_CONTROL:
           begin
             strReason := 'WTS_SESSION_REMOTE_CONTROL';
             // GetSystemMetrics(SM_REMOTECONTROL);
           end;
      else
        strReason := 'WTS_Unknown';
     end;
   // Write strReason to a Memo
   //ShowMessage(strReason + ' ' + IntToStr(msg.Lparam));
   Memo1.Lines.Add(strReason + ' ' + IntToStr(msg.Lparam));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 // retrieve current session ID
 //ShowMessage(Inttostr(GetCurrentSessionID));
 Memo1.Lines.Add('CurrentSessionID '+ Inttostr(GetCurrentSessionID))
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // register the window to receive session change notifications.
  FRegisteredSessionNotification := RegisterSessionNotification(Handle, NOTIFY_FOR_THIS_SESSION);
  Application.OnMessage := AppMessage;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // unregister session change notifications.
  if FRegisteredSessionNotification then
    UnRegisterSessionNotification(Handle);
end;

end.

Leider kann ich aber keine Änderung der

Code:

Msg.Message = WM_WTSSESSION_CHANGE

feststellen. Es passiert weder unter Windows XP noch unter Windows 10 etwas.
Fehlermeldungen gibt es auch nicht...

Kann mir bitte jemand einen Tipp geben?

Danke und viele Grüße!

Markus