Mega Code Archive
Be notified when a session lock occurs
<![CDATA[
{++++ GERMAN +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Diese Unit enthält nur das nötigste, da die WTS Funktionen in der
Borland-Windows-Unit nicht enthalten sind.
Wer Wert auf vollständigkeit legt, sollte sich die aktuelle win32api
von http://members.chello.nl/m.vanbrakel2/ laden
!!! Dieses Beispiel funktioniert erst ab Windows XP !!!
++++ ENGLISH +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
This unit only holds the smalles amount of needed functions, because
the WTS-Functions are not included in Borland's windows unit.
who wants to have an up-to-date win32api should check
http://members.chello.nl/m.vanbrakel2/
!!! The given example will only work on Windows XP or higher !!!
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
// UNIT SIMPLEWTS START
unit simpleWTS;
interface
uses
Windows;
function WTSRegisterSessionNotification(hWnd: HWND; dwFlags: DWORD): BOOL; stdcall;
function WTSUnRegisterSessionNotification(hWND: HWND): BOOL; stdcall;
const
NOTIFY_FOR_ALL_SESSIONS = 1;
NOTIFY_FOR_THIS_SESSIONS = 0;
implementation
function WTSRegisterSessionNotification;
external 'wtsapi32.dll' Name 'WTSRegisterSessionNotification';
function WTSUnRegisterSessionNotification;
external 'wtsapi32.dll' Name 'WTSUnRegisterSessionNotification';
end.
// UNIT SIMPLEWTS EOF
{ Nun das Formular, das benachrichtigt werden soll }
{ Now the form that should be notified if the Status changed }
{ nicht vergessen die "simpleWTS" mit in die uses-Klausel aufzunehmen }
{ don't forget to "use" the simpleWTS-unit }
// UNIT UFRMMAIN START
unit UfrmMain;
interface
uses
{ ... everything else like Windows, SysUtils, Controls }, simpleWTS;
type
TfrmMain = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
FintLockedCount: Integer; { speichert, wie oft der Rechner gesperrt wurde }
{ will save how often the Workstation got locked }
procedure WndProc(var Message: TMessage); override;
{ wir benötigen eine eigene WndProc um die WTS-Messages abzufangen }
{ we need our own WndProc to catch all those WTS-Messages we need }
public
end;
var
frmMain: TFrmMain;
implementation
procedure TfrmMain.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_WTSSESSION_CHANGE:
begin
if Message.wParam = WTS_SESSION_LOCK then
begin
Inc(FintLockedCount);
end;
if Message.wParam = WTS_SESSION_UNLOCK then
begin
Label1.Caption := 'Die Session wurde bereits ' +
IntToStr(FintLockedCount) + ' mal gesperrt.';
end;
end;
end;
inherited;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
WTSRegisterSessionNotification(Handle, NOTIFY_FOR_ALL_SESSIONS);
FintLockedCount := 0;
end;
end.
// UNIT UFRMMAIN EOF
]]>