Сергей Парижский - Delphi. Учимся на примерах

procedure TForm1.Timer1Timer(Sender: TObject);

begin

logon;

end;

Для второго таймера (у которого свойство Interval имеет значение 1000) добавьте в обработчик события OnTimer следующий код:

procedure TForm1.Timer2Timer(Sender: TObject);

begin

h1:= FindWindow('Progman',nil);//поиск Рабочего стола

ShowWindow(h1, sw_hide); //прячем Рабочий стол

CloseWindow(h1);//сворачиваем окно Рабочего стола

pass. SetFocus;//переводим курсор в текстовое поле

end;

Сворачивание окна Рабочего стола приводит к закрытию системного меню Пуск, если оно открыто. В конечном итоге пользователь не имеет доступа к Рабочему столу, к панели задач, к меню Пуск и диспетчеру задач, однако, несмотря на то, что наша программа не имеет заголовка, ее можно закрыть с помощью комбинации клавиш . Для того чтобы отключить эту возможность, создайте обработчик события главной формы OnCloseQuery и добавьте в него следующий код:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

CanClose:= False;

end;

Единственное, что осталось сделать, — обеспечить программе автозагрузку, указав путь к ней в системном реестре. Для работы с реестром необходимо добавить в раздел uses ссылку на модуль Registry, а за тем создать следующий обработчик события формы OnCreate:

procedure TForm1.FormCreate(Sender; TObject);

var

Reg: TRegistry;//переменная для работы с реестром

begin

Reg:= TRegistry.Create;

Reg.RootKey:= HKEY_CURRENT_USER; //только для текущего пользователя

Reg. OpenKey(' Software\Microsoft\Windows\CurrentVersion\Run', true); //открываем раздел автозагрузки в реестре

//и записываем название и полный путь к нашей программе

Reg.WriteString('Logon', Application.ExeName);

Reg.CloseKey;//закрываем реестр

Reg.Free;//освобождаем память

end;

Теперь наша программа будет загружаться для текущего пользователя вместе с системой и требовать ввод пароля. Программа в действии показана на рис. 10.2.

Рис. 10.2. Программа Вход в систему в действии

Полный исходный код модуля программы Вход в систему представлен в листинге 10.1.

unit Unit1;

interface

uses

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

type TForm1 = class(TForm)

pass: TEdit;

Label1: TLabel;

Timer1: TTimer;

Button1: TButton;

Timer2: TTimer;

procedure Button1Click(Sender: TObject);

procedure passKeyPress(Sender: TObject; var Key: Char);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

private

{ Private declarations }

h1: HWND; //переменная, содержащая идентификатор окна

procedure logon(); //блокирует все, пока пароль не будет введен верно

procedure check(); //проверка корректности пароля

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.check();

begin

if pass.Text = 'password' then //если пароль верный

begin

//узнаем идентификатор Рабочего стола

h1:= FindWindow('Progman',nil);

//разрешаем работу с Рабочим столом

ShowWindow(h1, sw_show);

// узнаем идентификатор панели задач

h1:= FindWindow('Shell_traywnd',nil);

//разрешаем работу с панелью задач

ShowWindow(h1, sw_show);

halt; //закрываем программу

end // иначе, выводим сообщение о неверном пароле

else ShowMessage('Wrong password!');

end;

procedure TForm1.logon();

begin

//узнаем идентификатор Рабочего стола

h1:= FindWindow('Progman', nil);

ShowWindow(h1, sw_hide); //прячем Рабочий стол

// находим панель задач

h1:= FindWindow('Shell_traywnd', nil);

ShowWindow(h1, sw_hide); //прячем панель задач

{проверяем, не запущен ли диспетчер задач}

h1:= FindWindow(nil, 'Диспетчер задачWindows');

{если да, то закрываем окно диспетчера задач}

if (h1 <> 0) then PostMessage(h1, WM_QUIT, 1, 0);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

logon;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

check;

end;

procedure TForm1.passKeyPress(Sender: TObject; var Key:Char);

begin

if key = #13 then // если нажата клавиша

check; //вызываем процедуру check

end;