ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/examples/services/ListUsersUnit.pas

Comparing ibx/trunk/examples/services/ListUsersUnit.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 1 | Line 1
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+}
#	Line 6 | Line 32 | interface
32
33		uses
34		Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	<	Grids, IBServices;
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	<	StringGrid1: TStringGrid;
63	<	procedure Button1Click(Sender: TObject);
64	<	procedure Button2Click(Sender: TObject);
65	<	procedure Button3Click(Sender: TObject);
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 StringGrid1EditingDone(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);
30	–	procedure UpdateUser(row: integer);
82		public
83		{ public declarations }
84		end;
#	Line 39 | Line 90 | implementation
90
91		{$R *.lfm}
92
93	+	uses NewUserDlgUnit, ChgPasswordDlgUnit;
94	+
95		{ TListUsersForm }
96
97		procedure TListUsersForm.FormShow(Sender: TObject);
#	Line 46 | Line 99 | begin
99		Application.QueueAsyncCall(@DoRefresh,0);
100		end;
101
102	<	procedure TListUsersForm.Button1Click(Sender: TObject);
102	>	procedure TListUsersForm.SaveChangesExecute(Sender: TObject);
103		begin
104	<	if MessageDlg(Format('Do you really want delete user %s',[StringGrid1.Cells[2,StringGrid1.row]]),
105	<	mtConfirmation,[mbYes,mbNo],0) = mrYes then
106	<	with IBSecurityService1 do
107	<	begin
108	<	UserName := StringGrid1.Cells[2,StringGrid1.row];
109	<	DeleteUser;
110	<	Application.QueueAsyncCall(@DoRefresh,0);
111	<	end;
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.Button2Click(Sender: TObject);
120	>	procedure TListUsersForm.AddUserExecute(Sender: TObject);
121		var NewUserName: string;
122		NewPassword: string;
64	–	NewRow: integer;
123		begin
124		NewUserName := '';
125	<	if InputQuery('Add New User','Enter UserName',NewUserName) and
126	<	InputQuery('Add New User ','Enter password',true,NewPassword) then
69	<	with IBSecurityService1 do
125	>	if NewUserDlg.ShowModal(NewUserName,NewPassword) = mrOK then
126	>	with UserList do
127		begin
128	<	UserName := NewUserName;
129	<	Password := NewPassword;
130	<	AddUser;
74	<	Application.QueueAsyncCall(@DoRefresh,0);
128	>	Append;
129	>	FieldByName('UserName').AsString := NewUserName;
130	>	FieldByName('Password').AsString := NewPassword;
131		end;
132		end;
133
134	<	procedure TListUsersForm.Button3Click(Sender: TObject);
134	>	procedure TListUsersForm.ChangePasswordExecute(Sender: TObject);
135		var NewPassword: string;
136		begin
137		NewPassword := '';
138	<	if InputQuery('Change Password for user ' + StringGrid1.Cells[2,StringGrid1.row],
139	<	'Enter new password',true,NewPassword) then
138	>	if ChgPasswordDlg.ShowModal(NewPassword) = mrOK then
139	>	with UserList do
140		begin
141	<	IBSecurityService1.Password := NewPassword;
142	<	UpdateUser(StringGrid1.row);
141	>	Edit;
142	>	FieldByName('Password').AsString := NewPassword;
143		end;
144		end;
145
146	<	procedure TListUsersForm.StringGrid1EditingDone(Sender: TObject);
146	>	procedure TListUsersForm.ChangePasswordUpdate(Sender: TObject);
147		begin
148	<	if StringGrid1.RowCount > 1 then
93	<	UpdateUser(StringGrid1.row);
148	>	(Sender as TAction).Enabled := UserList.Active and (UserList.RecordCount > 0);
149		end;
150
151	<	procedure TListUsersForm.DoRefresh(Data: PtrInt);
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	<	Active := true;
169	>	IBSecurityService1.Active := true;
170	>	IBDynamicGrid1.Columns[6].ReadOnly := not HasAdminRole;
171		DisplayUsers;
172	<	StringGrid1.RowCount := UserInfoCount + 1;
173	<	for i := 0 to UserInfoCount - 1 do
174	<	with UserInfo[i] do
175	<	begin
176	<	StringGrid1.Cells[0,i+1] := IntToStr(UserID);
177	<	StringGrid1.Cells[1,i+1] := IntToStr(GroupID);
178	<	StringGrid1.Cells[2,i+1] := UserName;
179	<	StringGrid1.Cells[3,i+1] := FirstName;
180	<	StringGrid1.Cells[4,i+1] := MiddleName;
181	<	StringGrid1.Cells[5,i+1] := LastName;
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.UpdateUser(row: integer);
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	<	UserID := StrToInt(StringGrid1.Cells[0,row]);
214	<	GroupID := StrToInt(StringGrid1.Cells[1,row]);
215	<	UserName := StringGrid1.Cells[2,row];
216	<	FirstName := StringGrid1.Cells[3,row];
217	<	MiddleName := StringGrid1.Cells[4,row];
218	<	LastName := StringGrid1.Cells[5,row];
219	<	ModifyUser
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.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines