ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/services/ListUsersUnit.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 3841 byte(s)
Log Message:
Fixes Merged

File Contents

# 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 ActnList, Menus, db, IBDatabase,
36 IBXServices, IBDynamicGrid;
37
38 type
39
40 { TListUsersForm }
41
42 TListUsersForm = class(TForm)
43 Button4: TButton;
44 IBXSecurityService1: TIBXSecurityService;
45 UserList: TIBXServicesUserList;
46 MenuItem1: TMenuItem;
47 MenuItem2: TMenuItem;
48 MenuItem3: TMenuItem;
49 MenuItem4: TMenuItem;
50 MenuItem5: TMenuItem;
51 MenuItem6: TMenuItem;
52 PopupMenu1: TPopupMenu;
53 SaveChanges: TAction;
54 DeleteUser: TAction;
55 ChangePassword: TAction;
56 AddUser: TAction;
57 ActionList1: TActionList;
58 Button1: TButton;
59 Button2: TButton;
60 Button3: TButton;
61 IBDynamicGrid1: TIBDynamicGrid;
62 Label1: TLabel;
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 private
73 { private declarations }
74 public
75 { public declarations }
76 end;
77
78 var
79 ListUsersForm: TListUsersForm;
80
81 implementation
82
83 {$R *.lfm}
84
85 uses NewUserDlgUnit, ChgPasswordDlgUnit;
86
87 { TListUsersForm }
88
89 procedure TListUsersForm.FormShow(Sender: TObject);
90 begin
91 UserList.Active := true;
92 end;
93
94 procedure TListUsersForm.SaveChangesExecute(Sender: TObject);
95 begin
96 UserList.Post;
97 end;
98
99 procedure TListUsersForm.SaveChangesUpdate(Sender: TObject);
100 begin
101 (Sender as TAction).Enabled := UserList.State in [dsInsert,dsEdit];
102 end;
103
104 procedure TListUsersForm.AddUserExecute(Sender: TObject);
105 var NewUserName: string;
106 NewPassword: string;
107 begin
108 NewUserName := '';
109 if NewUserDlg.ShowModal(NewUserName,NewPassword) = mrOK then
110 with UserList do
111 begin
112 Append;
113 FieldByName('SEC$USER_NAME').AsString := NewUserName;
114 FieldByName('SEC$PASSWORD').AsString := NewPassword;
115 end;
116 end;
117
118 procedure TListUsersForm.ChangePasswordExecute(Sender: TObject);
119 var NewPassword: string;
120 begin
121 NewPassword := '';
122 if ChgPasswordDlg.ShowModal(NewPassword) = mrOK then
123 with UserList do
124 begin
125 Edit;
126 FieldByName('SEC$PASSWORD').AsString := NewPassword;
127 end;
128 end;
129
130 procedure TListUsersForm.ChangePasswordUpdate(Sender: TObject);
131 begin
132 (Sender as TAction).Enabled := UserList.Active and (UserList.RecordCount > 0);
133 end;
134
135 procedure TListUsersForm.DeleteUserExecute(Sender: TObject);
136 begin
137 if MessageDlg(Format('Do you really want delete user %s',[UserList.FieldByName('SEC$USER_NAME').AsString]),
138 mtConfirmation,[mbYes,mbNo],0) = mrYes then
139 UserList.Delete;
140 end;
141
142 procedure TListUsersForm.FormClose(Sender: TObject;
143 var CloseAction: TCloseAction);
144 begin
145 UserList.Active := false;
146 end;
147
148 end.
149