Если приложение содержит коммерческую или приватную информацию, то разумно ограничить доступ к данным, добавив форму аутентификации.
My Visual Database имеет встроенную систему управления доступом. Чтоб её активировать, перейдите в закладку “Таблицы базы данных” и нажмите на кнопку “Управление доступом” (1). В открывшемся окне установите чекер “Включить управление доступом” (2), а затем сформируйте список ролей (4), используя кнопки редактирования (3). Чтобы изменения вступили в силу, не забудьте нажать кнопку “ОК” (5).

На вкладке “Настройки” находятся дополнительные параметры, которые определяют внешний вид элемента ввода логина (1) и возможность ввода пустого пароля (2).

После сохранения настроек в проекте появятся две системные таблицы: _role и _user.

Для каждого пользователя программы нужно создать учетную запись в таблице _user и назначить роль, которая определяет права доступа. Кроме пароля и логина, в учетной записи хранится информация об имени пользователя, адресе его электронной почты, дате создания учетной записи и времени последнего входа в программу. Более подробно встроенная система авторизации описана в моей книге “Визуальное программирование”.

Служебные поля в этих таблицах вы не сможете удалить или отредактировать, но при необходимости можно добавить свои поля.
При первом запуске программы автоматически будет добавлена запись в таблицу _user, чтобы можно было зайти в программу под администратором и добавить учетные записи с указанием ролей.

Теперь перед появлением главной формы приложения отображается форма авторизации:

На мой взгляд форма страдает низкой информативностью и выбивается из привычного стиля. Но с помощью скриптов ситуацию можно исправить. Рассмотрим форму повнимательней с помощью инструмента “Component Explorer”, который входит в состав “Справочника разработчика”.

Зная имена формы и компонентов, можно их модифицировать, сделав форму более понятней и функциональней с помощью процедуры App_LoginForm_OnActivate(), для вызова которой будет использовано событие onActivate. Обычно для таких целей используется событие onShow, но в приложении оно задействовано системным кодом, и если назначить свой обработчик событию onShow, форма авторизации перестанет работать.
procedure App_LoginForm_OnActivate(Sender: TObject);
// активация формы логина
// событие OnShow используется системой, поэтому его перекрывать нельзя
var
frmpForm:TForm;
tmpImage: TImage;
tmpButton: TButton;
tmpPanLogin: TPanel;
tmpPanPassword: TPanel;
tmpEdtLogin: TEdit;
tmpEdtPassword: TEdit;
tmpCombo: TdbCombobox;
i: integer;
tmpImageFileName :string;
tmpLabel:TLabel;
tmpCheck: TdbCheckBox;
tmpLogin: string;
// для оптимизации кода (меньше копипаста)
procedure SetAttr( ACont: TControl; AParent:TWinControl; AMTop: integer; AMBottom: integer; AMLeft: integer; AMRight: integer; );
begin
with ACont do
begin
Parent := AParent;
AlignWithMargins := True;
Margins.Top := AMTop;
Margins.Bottom := AMBottom;
Margins.Left := AMLeft;
Margins.Right := AMRight;
// Align := // не реализован в MVDB, но есть у TControl
end;
end;
begin
FindC(frmdbCoreLogin,'labLogin',tmpLabel,False);
// то, что ниже, выполняется один раз, при первом открытии формы
if tmpLabel = nil then
begin
// основные компоненты можно найти по имени
FindC(frmdbCoreLogin,'Image1',tmpImage);
FindC(frmdbCoreLogin,'bLogin',tmpButton);
FindC(frmdbCoreLogin,'pnPassword',tmpPanPassword);
FindC(frmdbCoreLogin,'pnLogin',tmpPanLogin);
FindC(frmdbCoreLogin,'edPassword',tmpEdtPassword);
FindC(frmdbCoreLogin,'edLogin',tmpEdtLogin);
//
FindC(frmdbCoreLogin,'cmbLogin',tmpCombo,False);
if tmpCombo = nil then
begin // компонент с выпадающим списком можно найти по типу
// но его может не быть, если в опциях управления доступом выбран вариант метод ввода пользоватлея - Текстовое поле
for i:=0 to frmdbCoreLogin.ComponentCount - 1 do
if frmdbCoreLogin.Components[i] is TdbCombobox then
begin
tmpCombo := TdbCombobox(frmdbCoreLogin.Components[i]);
tmpCombo.Name := 'cmbLogin';
tmpCombo.Text := '';
break;
end;
end;
// считываем сохраненный логин, если эта опция была включена
tmpLogin := IniFile_Read(APP_LOGIN_SECTION,APP_LOGIN_NAME, '' );
// в заголовке формы отображается название и версия
frmdbCoreLogin.Caption := APP_NAME + ' ' + App_GetVersion(False);
tmpImageFileName := ExtractFilePath(Application.ExeName)+APP_LOGIN_LOGO_FILE_NAME;
if not FileExists(tmpImageFileName) then
RaiseException('App_InitLoginForm() Не найден файл '+tmpImageFileName)
else
tmpImage.Picture.LoadFromFile(tmpImageFileName);
// форма будет прямоугольной, горизонтальной
frmdbCoreLogin.Width := 470;
frmdbCoreLogin.Height := 250;
// справа будет панель
with tmpPanPassword do
begin
Width := 220;
Align := alRight;
end;
// другая панель - оставшееся пространство
with tmpPanLogin do
begin
Align := alClient;
end;
// слева - картинка
SetAttr( tmpImage, tmpPanLogin, 8, 8, 8, 0 );
with tmpImage do
begin
Align := alClient;
Proportional := False;
end;
// всё остальное переносим на панель tmpPanPassword
// метка для поля ввода логина
tmpLabel := TLabel.Create(frmdbCoreLogin);
SetAttr( tmpLabel, tmpPanPassword, 8, 0, 8, 8 );
with tmpLabel do
begin
Name := 'labLogin';
Font.Size := 11;
Caption := 'Логин:';
Top := 0;
Align := alTop;
end;
//
SetAttr( tmpEdtLogin, tmpPanPassword, 2, 0, 8, 8 );
with tmpEdtLogin do
begin
Font.Size := 11;
Height := 24;
BorderStyle := bsSingle;
Top := tmpLabel.Top + tmpLabel.Height + 1;
Align := alTop;
end;
//
if tmpCombo <> nil then
begin
SetAttr( tmpCombo, tmpPanPassword, 2, 0, 8, 8 );
with tmpCombo do
begin
Font.Size := 11;
Top := tmpLabel.Top + tmpLabel.Height + 1;
Align := alTop;
end;
end;
//
tmpLabel := TLabel.Create(frmdbCoreLogin);
SetAttr( tmpLabel, tmpPanPassword, 8, 0, 8, 8 );
with tmpLabel do
begin
Name := 'labPassword';
Font.Size := 11;
Caption := 'Пароль:';
Top := tmpEdtLogin.Top + tmpEdtLogin.Height + 1;
Align := alTop;
end;
//
SetAttr( tmpEdtPassword, tmpPanPassword, 2, 0, 8, 8 );
with tmpEdtPassword do
begin
Font.Size := 11;
Height := 24;
BorderStyle := bsSingle;
Top := tmpLabel.Top + tmpLabel.Height + 1;
Align := alTop;
end;
//
if APP_LOGIN_SAVE_LAST_LOGIN then
begin
tmpCheck := TdbCheckBox.Create(frmdbCoreLogin);
SetAttr( tmpCheck, tmpPanPassword, 0, 8, 8, 8 );
with tmpCheck do
begin
Name := 'chbSaveLogin';
Caption := 'Сохранить логин';
Font.Size := 11;
Top := frmdbCoreLogin.ClientHeight - Height;
Align := alBottom;
Checked := tmpLogin <> '';
end;
end;
//
SetAttr( tmpButton, tmpPanPassword, 8, 8, 8, 8 );
with tmpButton do
begin
//
if tmpCheck <> nil then
Top := tmpCheck.Top - Height
else
Top := frmdbCoreLogin.ClientHeight - Height;
Align := alBottom;
end;
// если включен режим выбора из списка
if tmpCombo <> nil then
begin
tmpCombo.TabOrder := 0;
tmpCombo.ItemIndex := tmpCombo.Items.IndexOf(tmpLogin);
if tmpLogin = '' then
tmpCombo.SetFocus;
end
else
begin
tmpEdtLogin.TabOrder := 0;
tmpEdtLogin.Text := tmpLogin;
if tmpLogin = '' then
tmpEdtLogin.SetFocus;
end;
//
tmpEdtPassword.TabOrder := 1;
if tmpLogin <> '' then
tmpEdtPassword.SetFocus;
tmpButton.TabOrder := 2;
if tmpCheck <> nil then
tmpCheck.TabOrder := 3;
//
frmdbCoreLogin.OnHide := @App_LoginForm_OnClose;
end;
end;
Code language: Delphi (delphi)
Кода получилось много, но и результат превосходный:
- форма приобрела привычный для десктопа горизонтальный формат;
- у полей ввода появились метки с их описанием;
- в заголовке формы отображается название и версия программы;
- изображение является визиткой приложения;
- добавлена опция сохранения последнего выбранного логина.

Сохранение последнего выбранного логина уменьшает время доступа в программу, хотя и несколько снижает безопасность. Но не более, чем использование выпадающего списка для выбора логина. Данную опцию можно отключить, изменив значение глобальной переменной APP_LOGIN_SAVE_LAST_LOGIN.
Подключать обработчик App_LoginForm_OnActivate() нужно в основном блоке:
begin
// вызывается здесь, до отображения главной формы и до запуска основной логики приложения.
frmdbCoreLogin.onActivate := @App_LoginForm_OnActivate;
end.
Code language: Delphi (delphi)
Сохранение логина выполняется при закрытии формы:
procedure App_LoginForm_OnClose(Sender: TObject; );
// закрытие формы логина
var
tmpCheck: TdbCheckBox;
tmpCombo: TdbCombobox;
tmpEdtLogin: TEdit;
tmpLogin: string;
begin
// при необходимости записать параметры
FindC(frmdbCoreLogin,'edLogin',tmpEdtLogin);
FindC(frmdbCoreLogin,'cmbLogin',tmpCombo,False);
FindC(frmdbCoreLogin,'chbSaveLogin',tmpCheck,False);
// может быть или выпадающий список или поле ввода логина
if tmpCombo <> nil then
tmpLogin := tmpCombo.Text
else
tmpLogin := tmpEdtLogin.Text;
// если есть чекер и он установлен, то сохранить логин
if (tmpCheck <> nil) and tmpCheck.Checked then
begin
IniFile_Write(APP_LOGIN_SECTION,APP_LOGIN_NAME, tmpLogin );
end
else
begin
IniFile_Write(APP_LOGIN_SECTION,APP_LOGIN_NAME, '' );
end;
// сбросить пароль
TEdit( GetC(frmdbCoreLogin,'edPassword') ).Text := '';
end;
Code language: Delphi (delphi)
Права на меню
В My Visual Database права по ролям раздаются на элементы формы: кнопки, таблицы и поля ввода данных. А вот настройка главного меню по ролям не предусмотрена. Исправить это недочет нам помогут процедуры:
- Menu_AddAccessRight() – добавить права по ролям
- Menu_CheckAccessRight() – установить для меню видимость по ролям
Также будет полезным внести доработки в описанную ранее в статье “Простые движения и формы” (из цикла статей “Производство”) функцию Menu_Add(), добавив ещё один параметр – список ролей, для которых данный пункт меню будет доступен.
var
MenuAccessList:TStringList;
procedure Menu_AddAccessRight( AItem: TMenuItem; ARoleList:string );
// добавление прав к пункту меню
// AItem - пункт меню
// ARoleList - список ролей, которым разрешен доступ
begin
// список создается при первом обращении
if MenuAccessList = nil then
MenuAccessList := TStringList.Create;
//
MenuAccessList.AddObject( ARoleList, AItem );
end;
procedure Menu_CheckAccessRight;
// установка видимости пунктов меню согласно правам доступа - роли текущего пользователя
var
AItem: TMenuItem;
i: integer;
begin
if MenuAccessList <> nil then
begin
for i:=0 to MenuAccessList.Count - 1 do
begin
AItem := TMenuItem( MenuAccessList.Objects(i) );
AItem.Visible := pos( Application.User.Role, ','+MenuAccessList.Strings(i)+',' ) > 0;
end;
end;
end;
function Menu_Add( AName:string; ACaption: string; AParentItem:TMenuItem; AIndex:integer = -1; AOnClick:string = ''; ARoleList:string = ''; ):TMenuItem;
// добавление пункта меню
// AName - имя пункта; закладывается действие и параметр: <действие>_<параметр> ; действия: Show - отобразить форму на рабочей панели главной формы, параметр - имя формы
// ACaption - отображаемое название пункта меню
// AParentItem - родительский элемент; если nil, то пункт меню добавляется на верхний уровень
// AIndex - место, куда вставляем; -1 - добавляем в конец.
// AOnClick - обработчик
// ARoleList - список ролей, для которых пункт меню будет видимым; если пустой, то видим для всех
var
tmpForm:TForm;
begin
tmpForm := MainForm; // работаем с меню на главной форме
Result := TMenuItem.Create( tmpForm );
// если имя указано, то оформляем его по стандарту имен
if AName <> '' then
Result.Name := T_MENU_ITEM + AName; // добавляем префикс класса
Result.Caption := ACaption;
// если обработчик не указан, то назначить обработчик по умолчанию
if AOnClick = '' then
AOnClick := 'Menu_ItemOnClick';
// если обработчик не отключен, то добавляем его
if AOnClick <> '-' then
Result.OnClick := AOnClick;
// если родительский элемент не указан, то
if AParentItem = nil then
begin // добавляем пункт меню на верхний уровень
if AIndex = -1 then
tmpForm.Menu.Items.Add(Result)
else // или вставляем в указанную в параметре позицию
tmpForm.Menu.Items.Insert(AIndex,Result);
end
else // если указан, то
begin // добавляем как дочерний
if AIndex = -1 then
AParentItem.Add(Result)
else // или вставляем в указанную в параметре позицию
AParentItem.Insert(AIndex,Result);
end;
// добавляем права по ролям
if ARoleList <> '' then
Menu_AddAccessRight( Result, ARoleList );
end;
Code language: Delphi (delphi)
Пример использования
В приложении “Дисконт” я создал три роли:
- Директор
- Менеджер
- admin
Менеджеру доступна вся коммерческая информация, кроме справочника по скидкам, который может редактировать только Директор. Роль admin нужна, чтобы ограничить доступ к дизайнеру отчетов, экспорту и импорту данных для Менеджера и Директора.

Хотя у пользователя admin стоит роль Admin, которая ограничивает ему доступ к данным, вы должны понимать, что пользователь, у которого есть отметка Админ - Да, легко может обойти данное ограничение, создав нового пользователя с нужной ролью. Поэтому роль admin несет скорее косметическую роль, скрывая ненужные администратору пункты главного меню.
Инициализация главного меню выглядит так:
procedure UserApp_InitForm;
// инициализация форм
var
tmpItem:TMenuItem;
begin
try
// меню
//
tmpItem := Menu_Add('','Справочники',nil,1, '-','Директор,Менеджер'); // скрыть от админа
Menu_Add('Show_frmClient','Клиенты',tmpItem);
Menu_Add('Show_frmDiscount','Скидки',tmpItem,-1,'','Директор'); // доступно только диреткору
//
frmMain.mniFile.Caption := 'Журналы';
Menu_Add('Show_frmSale','Журнал продаж',frmMain.mniFile,0,'','Директор,Менеджер'); // скрыть от админа
Menu_Add('','-',frmMain.mniFile,1, '-','Директор,Менеджер');
//
tmpItem := Menu_Add('HelpTopic','?',nil,-1, '-');
Menu_Add('Help','Помощь',tmpItem,0,'Help_Show');
Menu_Add('','-',tmpItem,1, '-');
Menu_Add('AboutEx','О программе',tmpItem,2,'App_ShowCoreAbout');
Menu_HideItem('mniAbout');
// очень полезный пункт - смена пользователя без перезагрузки программы
Menu_Add('','Сменить пользователя ',frmMain.mniOptions,1, 'App_Relogin');
// скрыть служебные пункты от обычных пользователей
Menu_AddAccessRight( TMenuItem( GetC(frmMain,'mniReport') ) ,'Admin');
Menu_AddAccessRight( TMenuItem( GetC(frmMain,'mniExportData') ) ,'Admin');
Menu_AddAccessRight( TMenuItem( GetC(frmMain,'mniImportData') ) ,'Admin');
//
Menu_CheckAccessRight; // установить права по ролям
except
RaiseException('UserApp_InitForm() - '+ExceptionMessage);
end;
end;
Code language: Delphi (delphi)
Обратите внимание на сроку 23, в которой создается пункт меню для смены пользователя без перезагрузки программы. Процедура обработчика App_Relogin() выглядит так:
procedure App_Relogin(Sender:TObject);
// отображение стандартной формы "О программе"
var
tmpID: integer;
begin
tmpID := Application.User.id;
frmdbCoreLogin.ShowModal;
// Пользователь сменился?
if tmpID <> Application.User.id then
begin
Menu_CheckAccessRight; // применить новые права
App_CloseAllWindow; // закрыть все окна
end;
end;
Code language: Delphi (delphi)
Если пользователь сменился, то меняем видимость пунктов главного меню и закрываем все ранее открытые формы с помощью процедуры App_CloseAllWindow(), которая написана с учетом возможности использования навигатора.
procedure App_CloseAllWindow;
// закрытие всех окно
var
i: integer;
tmpPanel:TdbPanel;
tmpForm: TForm;
tmpButton: TdbButton;
begin
FindC(MainForm,FORM_WORK_PANEL,tmpPanel);
for i := 0 to tmpPanel.ControlCount - 1 do
begin
if (tmpPanel.Controls[i] is TForm) then
begin
tmpForm := TForm(tmpPanel.Controls[i]);
FindC(tmpForm,FORM_CLOSE_BUTTON,tmpButton);
if tmpButton <> nil then
tmpButton.Click
else
tmpForm.Close;
end;
end;
end;
Code language: Delphi (delphi)
Для удобства написания кода я решил добавить функцию GetC(), которая похожа на процедуру FindC() – она возвращает компонент по имени, а если что-то пошло не так, сообщает подробности ошибки:
function GetC(AForm: TForm; AName: string;):TComponent;
// альтернативная функция Form.FindComponent
begin
try
Result := AForm.FindComponent(AName);
except
if AForm = nil then
RaiseException('GetС() - форма не существует')
else
RaiseException('GetС('+AForm.Name+','+AName+') компонент не найден');
end;
end;
Code language: PHP (php)
Примечание
Для работы аутентификации потребуются константы:
const
APP_LOGIN_LOGO_FILE_NAME = 'Images\Logo\logo_190x190.jpg';
APP_LOGIN_SAVE_LAST_LOGIN = True;
APP_LOGIN_SECTION = 'LOGIN'; // раздел файла инициализации
APP_LOGIN_NAME = 'login'; // имя параметра
Code language: Delphi (delphi)
Обратите внимание, что некоторые процедуры и функции имеют в названии префикс – имя модуля, в котором она хранится. Например, App_CloseAllWindow() хранится в модуле app.pas, а Menu_Add() – в модуле menu.pas. Префикс не указывается для процедур и функций системного характера, которые часто используются. Они хранятся в модуле utils.pas. Например функция GetC(). Подробней об использовании модулей можно прочитать в статье “Эффект бабочки”.
Итоги
Доработана штатная форма логина, создана система прав для главного меню. Для полного счастья не хватает информационной панели для отображения данных о текущем пользователе и его роли. Размещать эту информацию в заголовке главной формы считаю нецелесообразным, так как это будет перегружать восприятие. Планирую создать статус-бар в нижней части и/или красивое меню на левой боковой панели. Вот там-то и должны быть элементы отображения данных о пользователе, желательно с фотографией и другими бизнес-атрибутами.
Продолжение следует
Отличная статья!
добрый день!
Пробовал делать все по статье, но выскакивает ошибка “Undeclared identifier: ‘APP_LOGIN_SECTION’, вполне возможно, что и дальше будет ошибки будут появляться по
С увеличением кода в проекте, уже начинается путаница. В статье написаны куски кода, но куда их вставлять не понятно. Может быть лучше подписывать, куда тот или иной код ставить? Например Procedure UserApp_InitForm; (UserApp.pas)
Вячеслав, благодарю за отзыв. Ваши замечания я учел и добавил поясняющее примечание: https://k245.ru/mvdb/autentifikatsiya.html#comment