Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Windows 10 Logon / Logoff erkennen (https://www.delphipraxis.net/206702-windows-10-logon-logoff-erkennen.html)

Corsair_ML 20. Jan 2021 18:45

Windows 10 Logon / Logoff erkennen
 
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

TiGü 20. Jan 2021 19:55

AW: Windows 10 Logon / Logoff erkennen
 
Hm, das du nach dem Aufrufen und damit dynamischen Laden von WTSRegisterSessionNotification und WTSUnRegisterSessionNotification die DLL gleich wieder entlädst scheint mir nicht ganz so richtig zu sein.
Ändere das mal.

Davon abgesehen sagt die MSDN:
Zitat:

Minimum supported client Windows Vista
Daher fällt jeder Versuch unter Windows XP ins Wasser.

Für Windows 10 probiere mal spaßeshalber NOTIFY_FOR_ALL_SESSIONS und die Variante mit
Delphi-Quellcode:
procedure WMWTSSESSIONCHANGE(var AMsg: TMessage); message WM_WTSSESSION_CHANGE;
anstatt über Application.OnMessage zu gehen (siehe: https://www.delphipraxis.net/97244-s...-erkennen.html).

Corsair_ML 20. Jan 2021 20:33

AW: Windows 10 Logon / Logoff erkennen
 
Hallo TiGü,

ich testete immer unter Windows 10:

Unregister kommt doch erst beim FormDestroy - oder habe ich was übersehen?
Code:
NOTIFY_FOR_ALL_SESSIONS
habe ich eingestellt - ohne Veränderung
Code:
procedure WMWTSSESSIONCHANGE(var AMsg: TMessage); message WM_WTSSESSION_CHANGE;
habe ich auch probiert, ebenfalls ohne Erfolg.
Kann es sein, dass es wie in dem verlinkten Post ist: das geht nur von Windows XP bis Vista?

Viele Grüße

Markus

TiGü 20. Jan 2021 21:56

AW: Windows 10 Logon / Logoff erkennen
 
Zitat:

Zitat von Ich
...die DLL gleich wieder entlädst...

Zitat:

Zitat von Corsair_ML (Beitrag 1481308)
Unregister kommt doch erst beim FormDestroy - oder habe ich was übersehen?

Kommentiere bitte mal alle FreeLibrary Aufrufe aus.

Moombas 21. Jan 2021 07:23

AW: Windows 10 Logon / Logoff erkennen
 
Ich kenne nun eure interne IT-Struktur (dürfen die Benutzer die Aufgabenplanung bearbeiten?) nicht, aber anstatt das über das eigene Programm laufen zu lassen, könntest du das über die Aufgabenplanung lösen:

Aufgabenplanung -> Windows -> 2 neue Aufgaben erstellen (jedesmal wenn dein Programm gestartet wird, prüfen ob die Aufgaben existieren, sonst neu anlegen)
1. Aufgabe: Trigger: Bei Arbeitsstationssperre (Pausen beginn) -> Sub-Programm ausführen das entweder einen entsprechenden Eintrag in eine Datenbank oder an deine Stechuhr übergibt.
2. Aufgabe: Trigger: Beim Aufheben der Arbeitsstationssperre (Pausen Ende) -> Sub-Programm ausführen das entweder einen entsprechenden Eintrag in eine Datenbank oder an deine Stechuhr übergibt.

OT: Ob ein gesperrter PC nun wirklich immer eine Pause zur Folge hat möchte ich dennoch in Frage stellen! Beim Gang zum WC oder Teilnahme an Meetings/Brainstorming odder ähnlichem wird der PC höchstwahrscheinlich gesperrt sein obwohl es keine Pause ist.
Und wer seinen PC in der Pause nicht sperrt, umgeht diesen Mechanismus... und komm mir nicht mit Autosperren nach X-Minuten, denn schon das verfälscht das Ergebnis und kann umgangen werden...

TiGü 21. Jan 2021 07:44

AW: Windows 10 Logon / Logoff erkennen
 
Moombas, es geht ihm um eine Stechuhr für Zuhause in der Heimarbeit (Home Office).

holger_barntrup 21. Jan 2021 07:46

AW: Windows 10 Logon / Logoff erkennen
 
Ich hatte über so was auch schon mal nachgedacht aber nie angegangen.
Mein Denkansatz war das aus dem Eventlog auszulesen.

Das hatte ich mir seinerzeit dazu gespeichert: https://theroadtodelphi.com/2011/10/...93-event-logs/

Die Ereignisse die dich interessieren sind die 4800 sperren u 4801 entsperren.

Vielleicht hilft es dir.

MyRealName 21. Jan 2021 07:54

AW: Windows 10 Logon / Logoff erkennen
 
Da sProblem ist, soweit ich weiss, das service object von Delphi. Es gibt Dir die Information einfach nicht, wenn diese Events eintreten. Ich habe für dieses Projekt einfach auf DDService gewechselt, das ist OpenSource und hat ein Event dafür "procedure TDDServiceSessionChange(Sender: TDDService; EventType, SessionID: Integer)"

EventType ist dabei deine WTS_XXXX mit Logon etc.

TiGü 21. Jan 2021 08:09

AW: Windows 10 Logon / Logoff erkennen
 
Wenn du jetzt eine funktionierende Lösung brauchst, dann kannst du dir auch das kostenlose WinLogOnView von NirSoft ansehen.
https://www.nirsoft.net/utils/window...imes_view.html

Das verwendet den Ansatz mit dem Eventlog/Ereignisanzeige.

Corsair_ML 21. Jan 2021 17:20

AW: Windows 10 Logon / Logoff erkennen
 
Hallo,

@TiGü
Ich habe die FreeLibrary Aufrufe auskommentiert, hat aber nichts geändert.
Mit dem Tool von NirSoft könnte man das händisch machen. Stimmt. Überlege ich mir, wenn ich wirklich keinen anderen Weg finde.

@holger_barntrup
Der von dir verlinkte Ansatz sieht interessant aus. Den werde ich mir anschauen.

@MyRealName
DDService habe ich nicht beim Suchen gefunden. Hast du dazu bitte einen Link?


Vielen Dank!

Markus

MyRealName 21. Jan 2021 18:15

AW: Windows 10 Logon / Logoff erkennen
 
Zitat:

Zitat von Corsair_ML (Beitrag 1481360)
@MyRealName
DDService habe ich nicht beim Suchen gefunden. Hast du dazu bitte einen Link?

Hier hast Du einen Link. War allerdings der erste, wenn man "Delphi DDService" in google sucht

Corsair_ML 21. Jan 2021 20:53

AW: Windows 10 Logon / Logoff erkennen
 
Hallo @MyRealName

Danke! Du hast Recht:
Zitat:

Hier hast Du einen Link. War allerdings der erste, wenn man "Delphi DDService" in google sucht
DuckDuckGo hat mir das nicht gezeigt. Werde wohl die Suchmaschine wieder wechseln...

Markus


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:10 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz