examples/services/ListUsersUnit.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
unit ListUsersUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, ActnList, Menus, db, memds, IBServices, IBCustomDataSet, IBDatabase,
  IBDynamicGrid;

type

  { TListUsersForm }

  TListUsersForm = class(TForm)
    Button4: TButton;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    PopupMenu1: TPopupMenu;
    SaveChanges: TAction;
    DeleteUser: TAction;
    ChangePassword: TAction;
    AddUser: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    IBDynamicGrid1: TIBDynamicGrid;
    IBSecurityService1: TIBSecurityService;
    Label1: TLabel;
    UserList: TMemDataset;
    UserListSource: TDataSource;
    procedure AddUserExecute(Sender: TObject);
    procedure ChangePasswordExecute(Sender: TObject);
    procedure ChangePasswordUpdate(Sender: TObject);
    procedure DeleteUserExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SaveChangesExecute(Sender: TObject);
    procedure SaveChangesUpdate(Sender: TObject);
    procedure UserListAfterInsert(DataSet: TDataSet);
    procedure UserListAfterOpen(DataSet: TDataSet);
    procedure UserListAfterPost(DataSet: TDataSet);
    procedure UserListBeforeClose(DataSet: TDataSet);
    procedure UserListBeforeDelete(DataSet: TDataSet);
    procedure UserListBeforePost(DataSet: TDataSet);
  private
    { private declarations }
    FLoading: boolean;
    procedure DoRefresh(Data: PtrInt);
  public
    { public declarations }
  end;

var
  ListUsersForm: TListUsersForm;

implementation

{$R *.lfm}

uses NewUserDlgUnit, ChgPasswordDlgUnit;

{ TListUsersForm }

procedure TListUsersForm.FormShow(Sender: TObject);
begin
  Application.QueueAsyncCall(@DoRefresh,0);
end;

procedure TListUsersForm.SaveChangesExecute(Sender: TObject);
begin
  UserList.Post;
end;

procedure TListUsersForm.SaveChangesUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := UserList.State in [dsInsert,dsEdit];
end;

procedure TListUsersForm.UserListAfterInsert(DataSet: TDataSet);
begin
  DataSet.FieldByName('UserID').AsInteger := 0;
  DataSet.FieldByName('GroupID').AsInteger := 0;
  DataSet.FieldByName('Admin').AsBoolean := false;
  DataSet.FieldByName('Password').Clear;
end;

procedure TListUsersForm.AddUserExecute(Sender: TObject);
var NewUserName: string;
    NewPassword: string;
begin
  NewUserName := '';
  if NewUserDlg.ShowModal(NewUserName,NewPassword) = mrOK then
  with UserList do
  begin
    Append;
    FieldByName('UserName').AsString := NewUserName;
    FieldByName('Password').AsString := NewPassword;
  end;
end;

procedure TListUsersForm.ChangePasswordExecute(Sender: TObject);
var NewPassword: string;
begin
  NewPassword := '';
  if ChgPasswordDlg.ShowModal(NewPassword) = mrOK then
  with UserList do
  begin
    Edit;
    FieldByName('Password').AsString := NewPassword;
  end;
end;

procedure TListUsersForm.ChangePasswordUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := UserList.Active and (UserList.RecordCount > 0);
end;

procedure TListUsersForm.DeleteUserExecute(Sender: TObject);
begin
  if MessageDlg(Format('Do you really want delete user %s',[UserList.FieldByName('UserName').AsString]),
        mtConfirmation,[mbYes,mbNo],0) = mrYes then
    UserList.Delete;
end;

procedure TListUsersForm.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  UserList.Active := false;
end;

procedure TListUsersForm.UserListAfterOpen(DataSet: TDataSet);
var i: integer;
begin
  with IBSecurityService1 do
  begin
    IBSecurityService1.Active := true;
    IBDynamicGrid1.Columns[6].ReadOnly := not HasAdminRole;
    DisplayUsers;
    FLoading := true;
    try
      for i := 0 to UserInfoCount - 1 do
      with UserInfo[i],UserList do
      begin
        Append;
        FieldByName('UserID').AsInteger := UserID;
        FieldByName('GroupID').AsInteger := GroupID;
        FieldByName('UserName').AsString := UserName;
        FieldByName('FirstName').AsString := FirstName;
        FieldByName('MiddleName').AsString := MiddleName;
        FieldByName('LastName').AsString := LastName;
        FieldByName('Password').Clear;
        FieldByName('Admin').AsBoolean := AdminRole;
        Post;
      end;
    finally
      FLoading := false;
    end;
  end;
end;

procedure TListUsersForm.UserListAfterPost(DataSet: TDataSet);
begin
  if not FLoading then
    Application.QueueAsyncCall(@DoRefresh,0);
end;

procedure TListUsersForm.UserListBeforeClose(DataSet: TDataSet);
begin
  with UserList do
  begin
    if State in [dsEdit,dsInsert] then Post;
    Clear(false);
  end;
end;

procedure TListUsersForm.UserListBeforeDelete(DataSet: TDataSet);
begin
  with IBSecurityService1 do
  begin
    Active := true;
    UserName := UserList.FieldByName('UserName').AsString;
    DeleteUser;
    while IsServiceRunning do;
  end;
end;

procedure TListUsersForm.UserListBeforePost(DataSet: TDataSet);
  procedure SetParams;
  begin
    with UserList, IBSecurityService1 do
    begin
      UserID := FieldByName('UserID').AsInteger;
      GroupID := FieldByName('GroupID').AsInteger;
      UserName := FieldByName('UserName').AsString;
      FirstName := FieldByName('FirstName').AsString;
      MiddleName := FieldByName('MiddleName').AsString;
      LastName := FieldByName('LastName').AsString;
      if not FieldByName('Password').IsNull then
        Password := FieldByName('Password').AsString;
      AdminRole := FieldByName('Admin').AsBoolean;
    end;
  end;

 begin
    if FLoading then Exit;
    IBSecurityService1.Active := true;
    case UserList.State of
    dsEdit:
      begin
        SetParams;
        IBSecurityService1.ModifyUser;
      end;
    dsInsert:
      begin
        SetParams;
        IBSecurityService1.AddUser;
      end;
    end;
    while IBSecurityService1.IsServiceRunning do;
end;

procedure TListUsersForm.DoRefresh(Data: PtrInt);
begin
  UserList.Active := false;
  UserList.Active := true;
end;

end.

Revision:	143
Committed:	Fri Feb 23 12:11:21 2018 UTC (6 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	7046 byte(s)
Log Message:	Fixes Merged
#	Content
1	(*
2	* IBX For Lazarus (Firebird Express)
3	*
4	* The contents of this file are subject to the Initial Developer's
5	* Public License Version 1.0 (the "License"); you may not use this
6	* file except in compliance with the License. You may obtain a copy
7	* of the License here:
8	*
9	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10	*
11	* Software distributed under the License is distributed on an "AS
12	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13	* implied. See the License for the specific language governing rights
14	* and limitations under the License.
15	*
16	* The Initial Developer of the Original Code is Tony Whyman.
17	*
18	* The Original Code is (C) 2015 Tony Whyman, MWA Software
19	* (http://www.mwasoftware.co.uk).
20	*
21	* All Rights Reserved.
22	*
23	* Contributor(s): ______________________________________.
24	*
25	*)
26
27	unit ListUsersUnit;
28
29	{$mode objfpc}{$H+}
30
31	interface
32
33	uses
34	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	Grids, ActnList, Menus, db, memds, IBServices, IBCustomDataSet, IBDatabase,
36	IBDynamicGrid;
37
38	type
39
40	{ TListUsersForm }
41
42	TListUsersForm = class(TForm)
43	Button4: TButton;
44	MenuItem1: TMenuItem;
45	MenuItem2: TMenuItem;
46	MenuItem3: TMenuItem;
47	MenuItem4: TMenuItem;
48	MenuItem5: TMenuItem;
49	MenuItem6: TMenuItem;
50	PopupMenu1: TPopupMenu;
51	SaveChanges: TAction;
52	DeleteUser: TAction;
53	ChangePassword: TAction;
54	AddUser: TAction;
55	ActionList1: TActionList;
56	Button1: TButton;
57	Button2: TButton;
58	Button3: TButton;
59	IBDynamicGrid1: TIBDynamicGrid;
60	IBSecurityService1: TIBSecurityService;
61	Label1: TLabel;
62	UserList: TMemDataset;
63	UserListSource: TDataSource;
64	procedure AddUserExecute(Sender: TObject);
65	procedure ChangePasswordExecute(Sender: TObject);
66	procedure ChangePasswordUpdate(Sender: TObject);
67	procedure DeleteUserExecute(Sender: TObject);
68	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
69	procedure FormShow(Sender: TObject);
70	procedure SaveChangesExecute(Sender: TObject);
71	procedure SaveChangesUpdate(Sender: TObject);
72	procedure UserListAfterInsert(DataSet: TDataSet);
73	procedure UserListAfterOpen(DataSet: TDataSet);
74	procedure UserListAfterPost(DataSet: TDataSet);
75	procedure UserListBeforeClose(DataSet: TDataSet);
76	procedure UserListBeforeDelete(DataSet: TDataSet);
77	procedure UserListBeforePost(DataSet: TDataSet);
78	private
79	{ private declarations }
80	FLoading: boolean;
81	procedure DoRefresh(Data: PtrInt);
82	public
83	{ public declarations }
84	end;
85
86	var
87	ListUsersForm: TListUsersForm;
88
89	implementation
90
91	{$R *.lfm}
92
93	uses NewUserDlgUnit, ChgPasswordDlgUnit;
94
95	{ TListUsersForm }
96
97	procedure TListUsersForm.FormShow(Sender: TObject);
98	begin
99	Application.QueueAsyncCall(@DoRefresh,0);
100	end;
101
102	procedure TListUsersForm.SaveChangesExecute(Sender: TObject);
103	begin
104	UserList.Post;
105	end;
106
107	procedure TListUsersForm.SaveChangesUpdate(Sender: TObject);
108	begin
109	(Sender as TAction).Enabled := UserList.State in [dsInsert,dsEdit];
110	end;
111
112	procedure TListUsersForm.UserListAfterInsert(DataSet: TDataSet);
113	begin
114	DataSet.FieldByName('UserID').AsInteger := 0;
115	DataSet.FieldByName('GroupID').AsInteger := 0;
116	DataSet.FieldByName('Admin').AsBoolean := false;
117	DataSet.FieldByName('Password').Clear;
118	end;
119
120	procedure TListUsersForm.AddUserExecute(Sender: TObject);
121	var NewUserName: string;
122	NewPassword: string;
123	begin
124	NewUserName := '';
125	if NewUserDlg.ShowModal(NewUserName,NewPassword) = mrOK then
126	with UserList do
127	begin
128	Append;
129	FieldByName('UserName').AsString := NewUserName;
130	FieldByName('Password').AsString := NewPassword;
131	end;
132	end;
133
134	procedure TListUsersForm.ChangePasswordExecute(Sender: TObject);
135	var NewPassword: string;
136	begin
137	NewPassword := '';
138	if ChgPasswordDlg.ShowModal(NewPassword) = mrOK then
139	with UserList do
140	begin
141	Edit;
142	FieldByName('Password').AsString := NewPassword;
143	end;
144	end;
145
146	procedure TListUsersForm.ChangePasswordUpdate(Sender: TObject);
147	begin
148	(Sender as TAction).Enabled := UserList.Active and (UserList.RecordCount > 0);
149	end;
150
151	procedure TListUsersForm.DeleteUserExecute(Sender: TObject);
152	begin
153	if MessageDlg(Format('Do you really want delete user %s',[UserList.FieldByName('UserName').AsString]),
154	mtConfirmation,[mbYes,mbNo],0) = mrYes then
155	UserList.Delete;
156	end;
157
158	procedure TListUsersForm.FormClose(Sender: TObject;
159	var CloseAction: TCloseAction);
160	begin
161	UserList.Active := false;
162	end;
163
164	procedure TListUsersForm.UserListAfterOpen(DataSet: TDataSet);
165	var i: integer;
166	begin
167	with IBSecurityService1 do
168	begin
169	IBSecurityService1.Active := true;
170	IBDynamicGrid1.Columns[6].ReadOnly := not HasAdminRole;
171	DisplayUsers;
172	FLoading := true;
173	try
174	for i := 0 to UserInfoCount - 1 do
175	with UserInfo[i],UserList do
176	begin
177	Append;
178	FieldByName('UserID').AsInteger := UserID;
179	FieldByName('GroupID').AsInteger := GroupID;
180	FieldByName('UserName').AsString := UserName;
181	FieldByName('FirstName').AsString := FirstName;
182	FieldByName('MiddleName').AsString := MiddleName;
183	FieldByName('LastName').AsString := LastName;
184	FieldByName('Password').Clear;
185	FieldByName('Admin').AsBoolean := AdminRole;
186	Post;
187	end;
188	finally
189	FLoading := false;
190	end;
191	end;
192	end;
193
194	procedure TListUsersForm.UserListAfterPost(DataSet: TDataSet);
195	begin
196	if not FLoading then
197	Application.QueueAsyncCall(@DoRefresh,0);
198	end;
199
200	procedure TListUsersForm.UserListBeforeClose(DataSet: TDataSet);
201	begin
202	with UserList do
203	begin
204	if State in [dsEdit,dsInsert] then Post;
205	Clear(false);
206	end;
207	end;
208
209	procedure TListUsersForm.UserListBeforeDelete(DataSet: TDataSet);
210	begin
211	with IBSecurityService1 do
212	begin
213	Active := true;
214	UserName := UserList.FieldByName('UserName').AsString;
215	DeleteUser;
216	while IsServiceRunning do;
217	end;
218	end;
219
220	procedure TListUsersForm.UserListBeforePost(DataSet: TDataSet);
221	procedure SetParams;
222	begin
223	with UserList, IBSecurityService1 do
224	begin
225	UserID := FieldByName('UserID').AsInteger;
226	GroupID := FieldByName('GroupID').AsInteger;
227	UserName := FieldByName('UserName').AsString;
228	FirstName := FieldByName('FirstName').AsString;
229	MiddleName := FieldByName('MiddleName').AsString;
230	LastName := FieldByName('LastName').AsString;
231	if not FieldByName('Password').IsNull then
232	Password := FieldByName('Password').AsString;
233	AdminRole := FieldByName('Admin').AsBoolean;
234	end;
235	end;
236
237	begin
238	if FLoading then Exit;
239	IBSecurityService1.Active := true;
240	case UserList.State of
241	dsEdit:
242	begin
243	SetParams;
244	IBSecurityService1.ModifyUser;
245	end;
246	dsInsert:
247	begin
248	SetParams;
249	IBSecurityService1.AddUser;
250	end;
251	end;
252	while IBSecurityService1.IsServiceRunning do;
253	end;
254
255	procedure TListUsersForm.DoRefresh(Data: PtrInt);
256	begin
257	UserList.Active := false;
258	UserList.Active := true;
259	end;
260
261	end.
262