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,
  ActnList, Menus, db, IBDatabase,
  IBXServices, IBDynamicGrid;

type

  { TListUsersForm }

  TListUsersForm = class(TForm)
    Button4: TButton;
    IBXSecurityService1: TIBXSecurityService;
    UserList: TIBXServicesUserList;
    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;
    Label1: TLabel;
    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);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  ListUsersForm: TListUsersForm;

implementation

{$R *.lfm}

uses NewUserDlgUnit, ChgPasswordDlgUnit;

{ TListUsersForm }

procedure TListUsersForm.FormShow(Sender: TObject);
begin
  UserList.Active := true;
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.AddUserExecute(Sender: TObject);
var NewUserName: string;
    NewPassword: string;
begin
  NewUserName := '';
  if NewUserDlg.ShowModal(NewUserName,NewPassword) = mrOK then
  with UserList do
  begin
    Append;
    FieldByName('SEC$USER_NAME').AsString := NewUserName;
    FieldByName('SEC$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('SEC$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('SEC$USER_NAME').AsString]),
        mtConfirmation,[mbYes,mbNo],0) = mrYes then
    UserList.Delete;
end;

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

end.

Revision:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	3841 byte(s)
Log Message:	propset for eol-style
#	User	Rev	Content
1	tony	143	(*
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	tony	45	unit ListUsersUnit;
28
29			{$mode objfpc}{$H+}
30
31			interface
32
33			uses
34			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	tony	209	ActnList, Menus, db, IBDatabase,
36			IBXServices, IBDynamicGrid;
37	tony	45
38			type
39
40			{ TListUsersForm }
41
42			TListUsersForm = class(TForm)
43	tony	143	Button4: TButton;
44	tony	209	IBXSecurityService1: TIBXSecurityService;
45			UserList: TIBXServicesUserList;
46	tony	143	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	tony	45	Button1: TButton;
59			Button2: TButton;
60			Button3: TButton;
61	tony	143	IBDynamicGrid1: TIBDynamicGrid;
62	tony	45	Label1: TLabel;
63	tony	143	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	tony	45	procedure FormShow(Sender: TObject);
70	tony	143	procedure SaveChangesExecute(Sender: TObject);
71			procedure SaveChangesUpdate(Sender: TObject);
72	tony	45	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	tony	143	uses NewUserDlgUnit, ChgPasswordDlgUnit;
86
87	tony	45	{ TListUsersForm }
88
89			procedure TListUsersForm.FormShow(Sender: TObject);
90			begin
91	tony	209	UserList.Active := true;
92	tony	45	end;
93
94	tony	143	procedure TListUsersForm.SaveChangesExecute(Sender: TObject);
95	tony	45	begin
96	tony	143	UserList.Post;
97	tony	45	end;
98
99	tony	143	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	tony	45	var NewUserName: string;
106			NewPassword: string;
107			begin
108			NewUserName := '';
109	tony	143	if NewUserDlg.ShowModal(NewUserName,NewPassword) = mrOK then
110			with UserList do
111	tony	45	begin
112	tony	143	Append;
113	tony	209	FieldByName('SEC$USER_NAME').AsString := NewUserName;
114			FieldByName('SEC$PASSWORD').AsString := NewPassword;
115	tony	45	end;
116			end;
117
118	tony	143	procedure TListUsersForm.ChangePasswordExecute(Sender: TObject);
119	tony	45	var NewPassword: string;
120			begin
121			NewPassword := '';
122	tony	143	if ChgPasswordDlg.ShowModal(NewPassword) = mrOK then
123			with UserList do
124	tony	45	begin
125	tony	143	Edit;
126	tony	209	FieldByName('SEC$PASSWORD').AsString := NewPassword;
127	tony	45	end;
128			end;
129
130	tony	143	procedure TListUsersForm.ChangePasswordUpdate(Sender: TObject);
131	tony	45	begin
132	tony	143	(Sender as TAction).Enabled := UserList.Active and (UserList.RecordCount > 0);
133	tony	45	end;
134
135	tony	143	procedure TListUsersForm.DeleteUserExecute(Sender: TObject);
136			begin
137	tony	209	if MessageDlg(Format('Do you really want delete user %s',[UserList.FieldByName('SEC$USER_NAME').AsString]),
138	tony	143	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	tony	45	end.
149