{$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.