VPF::Как отловить блокировку/разблокировку системы?

Данкинг

Дата 6.7.2008, 00:03 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: нет
Всего: 130

Т.е. работает моя программа. Пользователь блокирует систему ("компьютер используется и заблокирован, только администратор или Вася Пупкин может разблокировать"). Программа реагирует. Затем пользователь систему разблокирует, и программа снова реагирует на это.

--------------------

There's nothing left but silent epitaphs.

Rrader

Дата 6.7.2008, 06:19 (ссылка)

(голосов:1)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 29
Всего: 191

Код


unit Unit1;

interface

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

const
  WM_WTSSESSION_CHANGE = $2B1;
  WTS_SESSION_LOCK = 7;
  WTS_SESSION_UNLOCK = 8;
  NOTIFY_FOR_THIS_SESSION = 0;
  NOTIFY_FOR_ALL_SESSIONS = 1;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
    procedure OnWMWTSessionChange(var Msg: TMessage);
      message WM_WTSSESSION_CHANGE;
  private
    { Private declarations }
  public
    FNotification: BOOL;
    { Public declarations }
  end;

var
  Form1: TForm1;

// Routines
function RegisterSessionNotification(Wnd: HWND; dwFlags: DWORD): BOOL;
function UnRegisterSessionNotification(Wnd: HWND): BOOL;

implementation

{$R *.dfm}

function RegisterSessionNotification(Wnd: HWND; dwFlags: DWORD): BOOL;
type
  // WTS API
  TWTSRegisterSessionNotification = function(Wnd: HWND;
    dwFlags: DWORD): BOOL; stdcall;
var 
  hWTSapi32dll: THandle; 
  WTSRegisterSessionNotification: TWTSRegisterSessionNotification; 
begin 
  Result := False; 
  hWTSAPI32DLL := LoadLibrary('Wtsapi32.dll'); 
  if (hWTSAPI32DLL > 0) then
  try
    @WTSRegisterSessionNotification :=
      GetProcAddress(hWTSAPI32DLL, 'WTSRegisterSessionNotification');
    if Assigned(WTSRegisterSessionNotification) then
      Result := WTSRegisterSessionNotification(Wnd, dwFlags);
  finally
    if hWTSAPI32DLL > 0 then
      FreeLibrary(hWTSAPI32DLL);
  end;
end;

function UnRegisterSessionNotification(Wnd: HWND): BOOL;
type
  // WTS API
  TWTSUnRegisterSessionNotification = function(Wnd: HWND): BOOL; stdcall; 
var 
  hWTSapi32dll: THandle; 
  WTSUnRegisterSessionNotification: TWTSUnRegisterSessionNotification; 
begin 
  Result := False; 
  hWTSAPI32DLL := LoadLibrary('Wtsapi32.dll'); 
  if (hWTSAPI32DLL > 0) then 
  try
    @WTSUnRegisterSessionNotification :=
      GetProcAddress(hWTSAPI32DLL, 'WTSUnRegisterSessionNotification');
    if Assigned(WTSUnRegisterSessionNotification) then
      Result := WTSUnRegisterSessionNotification(Wnd);
  finally
    if hWTSAPI32DLL > 0 then
      FreeLibrary(hWTSAPI32DLL);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FNotification := RegisterSessionNotification(Handle, NOTIFY_FOR_THIS_SESSION);
end;

procedure TForm1.OnWMWTSessionChange(var Msg: TMessage);
begin
  case Msg.WParam of
    WTS_SESSION_LOCK: ShowMessage('WTS_SESSION_LOCK');
    WTS_SESSION_UNLOCK: ShowMessage('WTS_SESSION_UNLOCK');
  end;
end;

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

end.

--------------------

Let's do this quickly!
Rest in peace, Vit!

Данкинг

Дата 6.7.2008, 10:38 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: нет
Всего: 130

Ого. Спасибо, буду разбираться. smile

--------------------

There's nothing left but silent epitaphs.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »