{$R *.dfm}

function RegisterSessionNotification(Wnd: HWND; dwFlags: DWORD): Boolean;
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 Result := WTSRegisterSessionNotification(Wnd, dwFlags);
finally
if hWTSAPI32DLL > 0 then FreeLibrary(hWTSAPI32DLL);
end;
end;
end;

function UnRegisterSessionNotification(Wnd: HWND): Boolean;
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 Result:= WTSUnRegisterSessionNotification(Wnd);
finally
if hWTSAPI32DLL > 0 then FreeLibrary(hWTSAPI32DLL);
end;
end;
end;

function GetCurrentSessionID: Integer;
type
TProcessIdToSessionId = function(dwProcessId: DWORD; pSessionId: DWORD): BOOL; stdcall;
var
ProcessIdToSessionId: TProcessIdToSessionId;
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;

procedure TForm1.AppMessage(var Msg: TMSG; var Handled: Boolean);
var
strReason: string;
begin
Handled := False;
if Msg.Message = WM_WTSSESSION_CHANGE then
begin
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: strReason := 'WTS_SESSION_REMOTE_CONTROL';
else
strReason := 'WTS_Unknown';
end;
Memo1.Lines.Add(strReason + ' ' + IntToStr(msg.Lparam));
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(GetCurrentSessionID));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if FRegisteredSessionNotification then UnRegisterSessionNotification(Handle);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FRegisteredSessionNotification := RegisterSessionNotification(Handle, NOTIFY_FOR_THIS_SESSION);
Application.OnMessage := AppMessage;
end;

end.
A zbývá jen poslední informace, týkající se ostatních systémů Windows. Není třeba se obávat žádných chybových hlášení, program vybavený těmito funkcemi bude fungovat i na starších systémech, ale tyto funkce pochopitelně nebudou mít žádný efekt.

Vytvoříme si proto malou ukázkovou aplikaci, která bude toto přepínání hlídat. Poslouží nám k tomu dvě funkce. První zařídí, aby aplikace dostávala od systému upozornění na změnu session (tu použijeme při spuštění programu), druhou funkcí zase toto upozorňování zrušíme (při ukončení programu). Ještě přidáme navíc funkci pro detekci čísla aktuální session. V konstantách budou uloženy názvy jednotlivých stavů session (a zřejmě nemá cenu je překládat do češtiny, takže je ponechávám v původní podobě) a všechny výpisy budou prováděny do komponenty Memo. Umístěte ji proto na prázdný formulář. Jelikož totiž po přepnutí uživatele nebudete mít k aplikaci přístup, bude záznam o této změně vypsán právě do komponenty Memo a po opětovném přepnutí zpět si můžete jednotlivé stavy prohlédnout. Poslední věcí je tlačítko, které rovněž přidejte na formulář. Po jeho stisku bude zobrazeno číslo session, což má v tomto případě spíše ukázkový charakter, protože budete vidět vždy jen vaší aktuální session (po přepnutí na jiného uživatele pochopitelně tlačítko nepůjde stisknout, protože neuvidíte vůbec samotnou aplikaci). V "ostrých" aplikacích však tato funkce své využití jistě najde a rovněž místo výpisu daných stavů do Memo se bude aplikace chovat jinak. A zde tedy již samotný kód. Pro dnešek opět kompletní unit pro snadnější zkopírování do Delphi.
unit Unit1;

interface

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

const

WM_WTSSESSION_CHANGE = $2B1;
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;
NOTIFY_FOR_THIS_SESSION = 0;
NOTIFY_FOR_ALL_SESSIONS = 1;

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

var
Form1: TForm1;

implementation

Kdysi jsme si v našem seriálu ukazovali, jak detekovat vypnutí či restart systému, protože to je stav, který je pro aplikaci poměrně důležitý. Aplikace v takovém případě může reagovat uložením dat a podobně. S příchodem Windows XP, které jsou stále rozšířenější, se nám celá věc drobně zkomplikovala. Přibyla nám totiž funkce na přepínání uživatelů, kdy nedojde k odhlášení uživatele v pravém slova smyslu, ale jeho aplikace běží na pozadí dál, zatímco může pracovat jiný přihlášený uživatel. Tyto spuštěné aplikace normálně pracují a pro aktuálního uživatele nejsou viditelné ani přístupné. A právě toto přepínání mezi uživateli se naučíme detekovat, aby mohla naše aplikace příslušným způsobem reagovat. V běžných případech to zřejmě nebude vůbec nutné, ale pokud je vaše aplikace natolik speciální, že by přepnutí uživatele mohlo vadit (přistupuje například k nějakým sdíleným prostředkům), jistě se bude tato detekce hodit. Program pak může reagovat tak, že některé své funkce omezí nebo úplně vypne, dokud nedojde opět k přepnutí na původního uživatele.