Tips (1541)

Tip Bewertung (8):

{++++ 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