source upload
This commit is contained in:
Razor12911
@@ -0,0 +1,611 @@
|
||||
(*
|
||||
Simple Almost-Real-Life example of the Synopse mORMot Framework.
|
||||
Written by Michal Gajek, http://migajek.com/
|
||||
|
||||
The demo doesn't depend on any 3rd party libraries nor components.
|
||||
|
||||
ToDO:
|
||||
[ ] in each ListBox / ComboBox "Object", instead of ID, keep RecordRef ?
|
||||
*)
|
||||
|
||||
unit Unit1;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, ComCtrls, StdCtrls, CheckLst, Grids,
|
||||
|
||||
SynCommons, mORMotUI, mORMot,
|
||||
SynSQLite3Static,
|
||||
|
||||
uCustomer;
|
||||
|
||||
type
|
||||
TForm1 = class(TForm)
|
||||
PageControl1: TPageControl;
|
||||
TabSheet1: TTabSheet;
|
||||
TabSheet2: TTabSheet;
|
||||
lbCustomers: TListBox;
|
||||
GroupBox1: TGroupBox;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
lblName: TLabel;
|
||||
lblSurname: TLabel;
|
||||
btnAddCustomer: TButton;
|
||||
lbTasks: TListBox;
|
||||
btnNewTask: TButton;
|
||||
cbCustomers: TComboBox;
|
||||
lbCustomerTasks: TListBox;
|
||||
Label3: TLabel;
|
||||
gbEditTask: TGroupBox;
|
||||
cbTaskPriority: TComboBox;
|
||||
CheckListBox1: TCheckListBox;
|
||||
TabSheet3: TTabSheet;
|
||||
Label4: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
Label7: TLabel;
|
||||
TabSheet4: TTabSheet;
|
||||
dgTable: TDrawGrid;
|
||||
edtQuery: TComboBox;
|
||||
tbUsers: TTabSheet;
|
||||
Label8: TLabel;
|
||||
lbUsers: TListBox;
|
||||
GroupBox2: TGroupBox;
|
||||
clbRoles: TCheckListBox;
|
||||
btnAddUser: TButton;
|
||||
dtRoleExpires: TDateTimePicker;
|
||||
Label9: TLabel;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnAddCustomerClick(Sender: TObject);
|
||||
procedure lbCustomersClick(Sender: TObject);
|
||||
procedure btnNewTaskClick(Sender: TObject);
|
||||
procedure cbCustomersClick(Sender: TObject);
|
||||
procedure lbTasksClick(Sender: TObject);
|
||||
procedure cbTaskPriorityChange(Sender: TObject);
|
||||
procedure CheckListBox1ClickCheck(Sender: TObject);
|
||||
procedure Label7Click(Sender: TObject);
|
||||
procedure edtQueryKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
procedure btnAddUserClick(Sender: TObject);
|
||||
procedure lbUsersClick(Sender: TObject);
|
||||
procedure clbRolesClickCheck(Sender: TObject);
|
||||
procedure clbRolesClick(Sender: TObject);
|
||||
procedure dtRoleExpiresChange(Sender: TObject);
|
||||
procedure PageControl1Change(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
function LoadCustomer(const ACustomerID: integer): TSQLCustomer;
|
||||
procedure DisplayCustomerInfo(const ACustomer: TSQLCustomer); overload;
|
||||
procedure DisplayCustomerInfo(const ACustomerID: integer); overload;
|
||||
procedure FillCustomersList(const AList: TStrings; const AClear: boolean = true);
|
||||
|
||||
function LoadTask(const ATaskID: integer): TSQLTask;
|
||||
procedure FillTasksList(const AList: TStrings; ATasks: TSQLTask);
|
||||
procedure LoadTasksForCustomer(const ACustomer: TSQLCustomer; const AList: TStrings);
|
||||
|
||||
procedure LoadQueryHistory();
|
||||
|
||||
procedure FillRolesList(const AList: TStrings);
|
||||
procedure FillUsersList(const AList: TStrings; const AClear: boolean = true);
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
uses ShellApi, DateUtils, uQueryHistory, Math;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
// loads customer data into "Details" box. Pass nil in order to clear the box.
|
||||
procedure TForm1.DisplayCustomerInfo(const ACustomer: TSQLCustomer);
|
||||
begin
|
||||
if ACustomer <> nil then
|
||||
begin
|
||||
lblName.Caption:= UTF8ToString(ACustomer.Firstname);
|
||||
lblSurname.Caption:= UTF8ToString(ACustomer.Surname);
|
||||
LoadTasksForCustomer(ACustomer, lbCustomerTasks.Items);
|
||||
end
|
||||
else
|
||||
begin
|
||||
lblName.Caption:= '';
|
||||
lblSurname.Caption:= '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.DisplayCustomerInfo(const ACustomerID: integer);
|
||||
var
|
||||
cust: TSQLCustomer;
|
||||
begin
|
||||
cust:= LoadCustomer(ACustomerID);
|
||||
try
|
||||
DisplayCustomerInfo(cust);
|
||||
finally
|
||||
FreeAndNil(cust);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TForm1.LoadCustomer(const ACustomerID: integer): TSQLCustomer;
|
||||
begin
|
||||
result:= TSQLCustomer.Create(globalClient, ACustomerID);
|
||||
end;
|
||||
|
||||
// loads a list of customers to a AList
|
||||
procedure TForm1.FillCustomersList(const AList: TStrings; const AClear: boolean = true);
|
||||
var
|
||||
cust: TSQLCustomer;
|
||||
begin
|
||||
// load all the customers
|
||||
try
|
||||
AList.BeginUpdate();
|
||||
if AClear then
|
||||
AList.Clear();
|
||||
cust:= TSQLCustomer.CreateAndFillPrepare(globalClient, '');
|
||||
while cust.FillOne do
|
||||
AList.AddObject(Format('%s, %s', [UTF8ToString(cust.Surname), UTF8ToString(cust.Firstname)]), Pointer(cust.ID)); // we keep integer ID as "Data" object
|
||||
|
||||
finally
|
||||
AList.EndUpdate();
|
||||
FreeAndNil(cust);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.FillTasksList(const AList: TStrings; ATasks: TSQLTask);
|
||||
var
|
||||
freeAfter: boolean;
|
||||
begin
|
||||
freeAfter:= ATasks = nil;
|
||||
if freeAfter then
|
||||
ATasks:= TSQLTask.CreateAndFillPrepare(globalClient, '');
|
||||
|
||||
try
|
||||
AList.BeginUpdate();
|
||||
AList.Clear();
|
||||
while ATasks.FillOne do
|
||||
AList.AddObject(Format('%s', [UTF8ToString(ATasks.Text)]), Pointer(ATasks.ID));
|
||||
finally
|
||||
AList.EndUpdate();
|
||||
if freeAfter then
|
||||
FreeAndNil(ATasks);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.LoadTasksForCustomer(const ACustomer: TSQLCustomer; const AList: TStrings);
|
||||
var
|
||||
task: TSQLTask;
|
||||
fIds: TIDDynArray;
|
||||
begin
|
||||
ACustomer.Tasks.DestGet(globalClient, ACustomer.ID, fIds);
|
||||
task:= TSQLTask.CreateAndFillPrepare(globalClient, TInt64DynArray(fIds));
|
||||
AList.BeginUpdate();
|
||||
AList.Clear();
|
||||
try
|
||||
while task.FillOne do
|
||||
AList.AddObject(Format('%s', [UTF8ToString(task.Text)]), Pointer(task.id));
|
||||
finally
|
||||
AList.EndUpdate();
|
||||
FreeAndNil(task);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TForm1.LoadTask(const ATaskID: integer): TSQLTask;
|
||||
begin
|
||||
result:= TSQLTask.Create(globalClient, ATaskID);
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
// clear all the fields.
|
||||
DisplayCustomerInfo(nil);
|
||||
FillCustomersList(lbCustomers.Items);
|
||||
cbCustomers.AddItem('<Any customer>', nil);
|
||||
cbCustomers.ItemIndex:= 0;
|
||||
FillCustomersList(cbCustomers.Items, false);
|
||||
cbCustomersClick(nil);
|
||||
|
||||
LoadQueryHistory();
|
||||
|
||||
FillRolesList(clbRoles.Items);
|
||||
FillUsersList(lbUsers.Items);
|
||||
|
||||
dtRoleExpires.DateTime:= IncMonth(Now(), 1);
|
||||
end;
|
||||
|
||||
procedure TForm1.btnAddCustomerClick(Sender: TObject);
|
||||
var
|
||||
cust: TSQLCustomer;
|
||||
begin
|
||||
|
||||
cust:= TSQLCustomer.Create;
|
||||
try
|
||||
cust.Firstname:= StringToUTF8(InputBox('First name', 'Customer first name', 'John'));
|
||||
cust.Surname:= StringToUTF8(InputBox('Surname', 'Customer surname', 'Doe'));
|
||||
if (cust.Firstname <> '') and (cust.Surname <> '') then
|
||||
globalClient.Add(cust, true);
|
||||
finally
|
||||
FreeAndNil(cust);
|
||||
FillCustomersList(lbCustomers.Items);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.lbCustomersClick(Sender: TObject);
|
||||
var
|
||||
cust: TSQLCustomer;
|
||||
begin
|
||||
if lbCustomers.ItemIndex <> -1 then
|
||||
begin
|
||||
// since we store record ID as object, now we can load it
|
||||
if lbCustomers.Items.Objects[lbCustomers.ItemIndex] <> nil then
|
||||
begin
|
||||
cust:= LoadCustomer( Integer(lbCustomers.Items.Objects[lbCustomers.ItemIndex]) );
|
||||
DisplayCustomerInfo(cust);
|
||||
FreeAndNil(cust);
|
||||
end
|
||||
end
|
||||
else
|
||||
DisplayCustomerInfo(nil);
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.btnNewTaskClick(Sender: TObject);
|
||||
var
|
||||
task: TSQLTask;
|
||||
begin
|
||||
|
||||
task:= TSQLTask.Create();
|
||||
try
|
||||
task.Text:= StringToUTF8(InputBox('Text', 'Task description', ''));
|
||||
task.Priority:= tpNormal;
|
||||
if (task.Text <> '') then
|
||||
globalClient.Add(task, true);
|
||||
finally
|
||||
FreeAndNil(task);
|
||||
FillTasksList(lbTasks.Items, nil);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.cbCustomersClick(Sender: TObject);
|
||||
var
|
||||
cust: TSQLCustomer;
|
||||
begin
|
||||
gbEditTask.Visible:= false;
|
||||
if cbCustomers.ItemIndex <> -1 then
|
||||
begin
|
||||
// since we store record ID as object, now we can load it
|
||||
if cbCustomers.Items.Objects[cbCustomers.ItemIndex] <> nil then
|
||||
begin
|
||||
cust:= LoadCustomer( Integer(cbCustomers.Items.Objects[cbCustomers.ItemIndex]) );
|
||||
LoadTasksForCustomer(cust, lbTasks.Items);
|
||||
FreeAndNil(cust);
|
||||
end
|
||||
else
|
||||
FillTasksList(lbTasks.Items, nil);
|
||||
end
|
||||
else
|
||||
FillTasksList(lbTasks.Items, nil);
|
||||
end;
|
||||
|
||||
procedure TForm1.lbTasksClick(Sender: TObject);
|
||||
var
|
||||
task: TSQLTask;
|
||||
cust: TSQLCustomer;
|
||||
clientsIds: TIDDynArray;
|
||||
i, j: integer;
|
||||
begin
|
||||
gbEditTask.Visible:= lbTasks.ItemIndex <> -1;
|
||||
if not gbEditTask.Visible then
|
||||
exit;
|
||||
|
||||
gbEditTask.Visible:= lbTasks.Items.Objects[lbTasks.ItemIndex] <> nil;
|
||||
if not gbEditTask.Visible then
|
||||
exit;
|
||||
|
||||
task:= LoadTask(integer(lbTasks.Items.Objects[lbTasks.ItemIndex]));
|
||||
cbTaskPriority.ItemIndex:= Ord(task.Priority);
|
||||
cbTaskPriority.Tag:= task.ID;
|
||||
|
||||
FillCustomersList(CheckListBox1.Items, true);
|
||||
CheckListBox1.Tag:= task.ID;
|
||||
// load list of customers assigned to the given task
|
||||
cust:= TSQLCustomer.Create();
|
||||
try
|
||||
cust.Tasks.SourceGet(globalClient, task.ID, clientsIds);
|
||||
for i:= low(clientsIds) to high(clientsIds) do
|
||||
begin
|
||||
|
||||
// find the client on the list (by ID)
|
||||
for j:= 0 to CheckListBox1.Count -1 do
|
||||
if Integer(CheckListBox1.Items.Objects[j]) = clientsIds[i] then
|
||||
CheckListBox1.Checked[j]:= true;
|
||||
end;
|
||||
finally
|
||||
cust.Free();
|
||||
FreeAndNil(task);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.cbTaskPriorityChange(Sender: TObject);
|
||||
var
|
||||
task: TSQLTask;
|
||||
begin
|
||||
if cbTaskPriority.Tag > 0 then
|
||||
begin
|
||||
task:= LoadTask(cbTaskPriority.Tag);
|
||||
if task <> nil then
|
||||
begin
|
||||
task.Priority:= TSQLTaskPriority(cbTaskPriority.ItemIndex);
|
||||
globalClient.Update(task);
|
||||
task.Free;
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TForm1.CheckListBox1ClickCheck(Sender: TObject);
|
||||
var
|
||||
task: TSQLTask;
|
||||
cust: TSQLCustomer;
|
||||
begin
|
||||
// first, load the Task based on ID (stored in TAG property)
|
||||
if (sender as TComponent).Tag > 0 then
|
||||
begin
|
||||
task:= LoadTask((sender as TComponent).Tag);
|
||||
if task <> nil then
|
||||
begin
|
||||
|
||||
// now load the customer from the list
|
||||
if CheckListBox1.ItemIndex > - 1 then
|
||||
begin
|
||||
cust:= LoadCustomer(Integer(CheckListBox1.Items.Objects[CheckListBox1.ItemIndex]));
|
||||
if cust <> nil then
|
||||
begin
|
||||
if CheckListBox1.Checked[CheckListBox1.ItemIndex] then
|
||||
cust.Tasks.ManyAdd(globalClient, cust.ID, task.ID, true)
|
||||
else
|
||||
cust.Tasks.ManyDelete(globalClient, cust.ID, task.ID);
|
||||
|
||||
FreeAndNil(cust);
|
||||
end;
|
||||
end;
|
||||
FreeAndNil(task);
|
||||
end;
|
||||
end
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.Label7Click(Sender: TObject);
|
||||
begin
|
||||
ShellExecute(0, 'open', 'http://code.google.com/p/synopse-sqlite-demo/', '', '', SW_SHOWNORMAL);
|
||||
end;
|
||||
|
||||
procedure TForm1.edtQueryKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
var
|
||||
data: TSQLTable;
|
||||
hist: TSQLQueryHistory;
|
||||
begin
|
||||
if Key = VK_RETURN then
|
||||
begin
|
||||
Key:= 0;
|
||||
|
||||
// we don't have to worry for freeing the data nor the "previously" created instance of TSQLTableToGrid
|
||||
// as the Framework takes care of everything.
|
||||
data:= globalClient.ExecuteList([], StringToUTF8(edtQuery.Text));
|
||||
TSQLTableToGrid.Create(dgTable, data, globalClient);
|
||||
|
||||
hist:= TSQLQueryHistory.Create(globalClient, 'SQL = ?', [edtQuery.Text]);
|
||||
try
|
||||
if hist.ID = 0 then
|
||||
hist.SQL:= StringToUTF8(edtQuery.Text);
|
||||
hist.LastUsed:= Now();
|
||||
if hist.ID > 0 then
|
||||
globalClient.Update(hist)
|
||||
else
|
||||
globalClient.Add(hist, true);
|
||||
finally
|
||||
FreeAndNil(hist);
|
||||
LoadQueryHistory();
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.LoadQueryHistory();
|
||||
var
|
||||
hist: TSQLQueryHistory;
|
||||
begin
|
||||
hist:= TSQLQueryHistory.Create();
|
||||
edtQuery.Items.BeginUpdate();
|
||||
edtQuery.Items.Clear();
|
||||
try
|
||||
hist.FillHistory();
|
||||
while hist.FillOne do
|
||||
edtQuery.AddItem(UTF8ToString(hist.SQL), nil);
|
||||
finally
|
||||
edtQuery.Items.EndUpdate();
|
||||
FreeAndNil(hist);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FillRolesList(const AList: TStrings);
|
||||
var
|
||||
role: TSQLUserRole;
|
||||
begin
|
||||
role:= TSQLUserRole.CreateAndFillPrepare(globalClient, '');
|
||||
AList.BeginUpdate();
|
||||
AList.Clear();
|
||||
try
|
||||
while role.FillOne do
|
||||
AList.AddObject(UTF8ToString(role.RoleName), Pointer(role.id));
|
||||
finally
|
||||
FreeAndNil(role);
|
||||
AList.EndUpdate();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FillUsersList(const AList: TStrings; const AClear: boolean = true);
|
||||
var
|
||||
user: TSQLUser;
|
||||
begin
|
||||
// load all the customers
|
||||
try
|
||||
AList.BeginUpdate();
|
||||
if AClear then
|
||||
AList.Clear();
|
||||
user:= TSQLUser.CreateAndFillPrepare(globalClient, '');
|
||||
while user.FillOne do
|
||||
AList.AddObject(Format('%s (%s, %s)', [UTF8ToString(user.login), UTF8ToString(user.Surname), UTF8ToString(user.Firstname)]), Pointer(user.ID)); // we keep integer ID as "Data" object
|
||||
|
||||
finally
|
||||
AList.EndUpdate();
|
||||
FreeAndNil(user);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TForm1.btnAddUserClick(Sender: TObject);
|
||||
var
|
||||
user: TSQLUser;
|
||||
begin
|
||||
|
||||
user:= TSQLUser.Create;
|
||||
try
|
||||
user.Firstname:= StringToUTF8( InputBox('First name', 'User first name', '') );
|
||||
user.Surname:= StringToUTF8( InputBox('Surname', 'User surname', '') );
|
||||
user.Login:= StringToUTF8( InputBox('Login', 'User login', '') );
|
||||
user.Password:= StringToUTF8( InputBox('Password', 'User password', '') );
|
||||
if (user.Firstname <> '') and (user.Surname <> '') and (user.Password <> '') and (user.Login <> '') then
|
||||
globalClient.Add(user, true)
|
||||
else
|
||||
MessageBox(handle, 'None of the data can be empty!', 'Wrong', MB_ICONEXCLAMATION);
|
||||
finally
|
||||
FreeAndNil(user);
|
||||
FillUsersList(lbUsers.Items);
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.lbUsersClick(Sender: TObject);
|
||||
var
|
||||
i, rowID: integer;
|
||||
user: TSQLUser;
|
||||
roles: TSQLUserRoles;
|
||||
date: TTimeLog;
|
||||
begin
|
||||
clbRoles.Enabled:= (lbUsers.ItemIndex > -1) and (lbUsers.Items.Objects[lbUsers.ItemIndex] <> nil);
|
||||
FillRolesList(clbRoles.Items); // clear names, dates and selections
|
||||
|
||||
if clbRoles.Enabled then
|
||||
begin
|
||||
user:= TSQLUser.Create(globalClient, integer(lbUsers.Items.Objects[lbUsers.ItemIndex]));
|
||||
|
||||
try
|
||||
for i:= 0 to clbRoles.Items.Count -1 do
|
||||
if user.HasRole('', integer(clbRoles.Items.Objects[i]), rowID) then
|
||||
begin
|
||||
clbRoles.Checked[i]:= true;
|
||||
try
|
||||
roles:= TSQLUserRoles.Create();
|
||||
// load the actual data (ValidUntil field)
|
||||
globalClient.Retrieve(rowID, roles);
|
||||
date := roles.ValidUntil;
|
||||
clbRoles.Items.Strings[i]:= clbRoles.Items.Strings[i] + Format(' [valid until %s]',
|
||||
[TTimeLogBits(date).Text(true)]);
|
||||
finally
|
||||
FreeAndNil(roles);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(user);
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TForm1.clbRolesClickCheck(Sender: TObject);
|
||||
var
|
||||
user: TSQLUser;
|
||||
roleID: integer;
|
||||
begin
|
||||
if clbRoles.ItemIndex = -1 then
|
||||
exit;
|
||||
|
||||
user:= TSQLUser.Create(globalClient, integer(lbUsers.Items.Objects[lbUsers.ItemIndex]));
|
||||
|
||||
try
|
||||
roleID:= Integer(clbRoles.Items.Objects[clbRoles.ItemIndex]);
|
||||
user.Roles.ValidUntil:= TimeLogFromDateTime( IncMonth(Now(), 1) );
|
||||
if user.HasRole('', roleID) then
|
||||
user.Roles.ManyDelete(globalClient, user.ID, roleID)
|
||||
else
|
||||
user.Roles.ManyAdd(globalClient, user.ID, roleID, true);
|
||||
finally
|
||||
FreeAndNil(user);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.clbRolesClick(Sender: TObject);
|
||||
var
|
||||
roles: TSQLUserRoles;
|
||||
roleID: integer;
|
||||
begin
|
||||
if clbRoles.ItemIndex = -1 then
|
||||
exit;
|
||||
|
||||
roleID:= integer(clbRoles.Items.Objects[clbRoles.ItemIndex]);
|
||||
roles:= TSQLUserRoles.Create();
|
||||
try
|
||||
//globalClient.Retrieve(rolesID, roles);
|
||||
roles.ManySelect(globalClient, integer(lbUsers.Items.Objects[lbUsers.ItemIndex]),roleID);
|
||||
if roles.id <> 0 then
|
||||
dtRoleExpires.DateTime:= TTimeLogBits(roles.ValidUntil).ToDate;
|
||||
finally
|
||||
FreeAndNil(roles);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.dtRoleExpiresChange(Sender: TObject);
|
||||
var
|
||||
roles: TSQLUserRoles;
|
||||
roleID: integer;
|
||||
begin
|
||||
if clbRoles.ItemIndex = -1 then
|
||||
exit;
|
||||
|
||||
roleID:= integer(clbRoles.Items.Objects[clbRoles.ItemIndex]);
|
||||
roles:= TSQLUserRoles.Create();
|
||||
try
|
||||
// select the record which associates currently selected user with currently selected role
|
||||
roles.ManySelect(globalClient, integer(lbUsers.Items.Objects[lbUsers.ItemIndex]), roleID);
|
||||
if roles.id <> 0 then
|
||||
begin
|
||||
roles.ValidUntil:= TimeLogFromDateTime(dtRoleExpires.DateTime);
|
||||
globalClient.Update(roles)
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(roles);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.PageControl1Change(Sender: TObject);
|
||||
begin
|
||||
if PageControl1.ActivePage = tbUsers then
|
||||
if currentUser <> nil then
|
||||
if not currentUser.HasRole('admin') then
|
||||
begin
|
||||
PageControl1.ActivePage:= TabSheet3;
|
||||
MessageBox(handle, 'You are not allowed to edit this content', 'Please sign-in as admin!', MB_ICONEXCLAMATION)
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user