examples/services/ListUsersUnit.pas

unit ListUsersUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, IBServices;

type

  { TListUsersForm }

  TListUsersForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    IBSecurityService1: TIBSecurityService;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure StringGrid1EditingDone(Sender: TObject);
  private
    { private declarations }
    procedure DoRefresh(Data: PtrInt);
    procedure UpdateUser(row: integer);
  public
    { public declarations }
  end;

var
  ListUsersForm: TListUsersForm;

implementation

{$R *.lfm}

{ TListUsersForm }

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

procedure TListUsersForm.Button1Click(Sender: TObject);
begin
  if MessageDlg(Format('Do you really want delete user %s',[StringGrid1.Cells[2,StringGrid1.row]]),
        mtConfirmation,[mbYes,mbNo],0) = mrYes then
  with IBSecurityService1 do
  begin
    UserName := StringGrid1.Cells[2,StringGrid1.row];
    DeleteUser;
    Application.QueueAsyncCall(@DoRefresh,0);
  end;
end;

procedure TListUsersForm.Button2Click(Sender: TObject);
var NewUserName: string;
    NewPassword: string;
    NewRow: integer;
begin
  NewUserName := '';
  if InputQuery('Add New User','Enter UserName',NewUserName) and
     InputQuery('Add New User ','Enter password',true,NewPassword) then
  with IBSecurityService1 do
  begin
    UserName := NewUserName;
    Password := NewPassword;
    AddUser;
    Application.QueueAsyncCall(@DoRefresh,0);
  end;
end;

procedure TListUsersForm.Button3Click(Sender: TObject);
var NewPassword: string;
begin
  NewPassword := '';
  if InputQuery('Change Password for user ' + StringGrid1.Cells[2,StringGrid1.row],
           'Enter new password',true,NewPassword) then
  begin
    IBSecurityService1.Password := NewPassword;
    UpdateUser(StringGrid1.row);
  end;
end;

procedure TListUsersForm.StringGrid1EditingDone(Sender: TObject);
begin
  if StringGrid1.RowCount > 1 then
    UpdateUser(StringGrid1.row);
end;

procedure TListUsersForm.DoRefresh(Data: PtrInt);
var i: integer;
begin
  with IBSecurityService1 do
  begin
    Active := true;
    DisplayUsers;
    StringGrid1.RowCount := UserInfoCount + 1;
    for i := 0 to UserInfoCount - 1 do
    with UserInfo[i] do
    begin
      StringGrid1.Cells[0,i+1] := IntToStr(UserID);
      StringGrid1.Cells[1,i+1] := IntToStr(GroupID);
      StringGrid1.Cells[2,i+1] := UserName;
      StringGrid1.Cells[3,i+1] := FirstName;
      StringGrid1.Cells[4,i+1] := MiddleName;
      StringGrid1.Cells[5,i+1] := LastName;
    end;
  end;
end;

procedure TListUsersForm.UpdateUser(row: integer);
begin
  with IBSecurityService1 do
  begin
    UserID := StrToInt(StringGrid1.Cells[0,row]);
    GroupID := StrToInt(StringGrid1.Cells[1,row]);
    UserName := StringGrid1.Cells[2,row];
    FirstName := StringGrid1.Cells[3,row];
    MiddleName := StringGrid1.Cells[4,row];
    LastName := StringGrid1.Cells[5,row];
    ModifyUser
  end;
end;

end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	3271 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	Content
1	unit ListUsersUnit;
2
3	{$mode objfpc}{$H+}
4
5	interface
6
7	uses
8	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9	Grids, IBServices;
10
11	type
12
13	{ TListUsersForm }
14
15	TListUsersForm = class(TForm)
16	Button1: TButton;
17	Button2: TButton;
18	Button3: TButton;
19	IBSecurityService1: TIBSecurityService;
20	Label1: TLabel;
21	StringGrid1: TStringGrid;
22	procedure Button1Click(Sender: TObject);
23	procedure Button2Click(Sender: TObject);
24	procedure Button3Click(Sender: TObject);
25	procedure FormShow(Sender: TObject);
26	procedure StringGrid1EditingDone(Sender: TObject);
27	private
28	{ private declarations }
29	procedure DoRefresh(Data: PtrInt);
30	procedure UpdateUser(row: integer);
31	public
32	{ public declarations }
33	end;
34
35	var
36	ListUsersForm: TListUsersForm;
37
38	implementation
39
40	{$R *.lfm}
41
42	{ TListUsersForm }
43
44	procedure TListUsersForm.FormShow(Sender: TObject);
45	begin
46	Application.QueueAsyncCall(@DoRefresh,0);
47	end;
48
49	procedure TListUsersForm.Button1Click(Sender: TObject);
50	begin
51	if MessageDlg(Format('Do you really want delete user %s',[StringGrid1.Cells[2,StringGrid1.row]]),
52	mtConfirmation,[mbYes,mbNo],0) = mrYes then
53	with IBSecurityService1 do
54	begin
55	UserName := StringGrid1.Cells[2,StringGrid1.row];
56	DeleteUser;
57	Application.QueueAsyncCall(@DoRefresh,0);
58	end;
59	end;
60
61	procedure TListUsersForm.Button2Click(Sender: TObject);
62	var NewUserName: string;
63	NewPassword: string;
64	NewRow: integer;
65	begin
66	NewUserName := '';
67	if InputQuery('Add New User','Enter UserName',NewUserName) and
68	InputQuery('Add New User ','Enter password',true,NewPassword) then
69	with IBSecurityService1 do
70	begin
71	UserName := NewUserName;
72	Password := NewPassword;
73	AddUser;
74	Application.QueueAsyncCall(@DoRefresh,0);
75	end;
76	end;
77
78	procedure TListUsersForm.Button3Click(Sender: TObject);
79	var NewPassword: string;
80	begin
81	NewPassword := '';
82	if InputQuery('Change Password for user ' + StringGrid1.Cells[2,StringGrid1.row],
83	'Enter new password',true,NewPassword) then
84	begin
85	IBSecurityService1.Password := NewPassword;
86	UpdateUser(StringGrid1.row);
87	end;
88	end;
89
90	procedure TListUsersForm.StringGrid1EditingDone(Sender: TObject);
91	begin
92	if StringGrid1.RowCount > 1 then
93	UpdateUser(StringGrid1.row);
94	end;
95
96	procedure TListUsersForm.DoRefresh(Data: PtrInt);
97	var i: integer;
98	begin
99	with IBSecurityService1 do
100	begin
101	Active := true;
102	DisplayUsers;
103	StringGrid1.RowCount := UserInfoCount + 1;
104	for i := 0 to UserInfoCount - 1 do
105	with UserInfo[i] do
106	begin
107	StringGrid1.Cells[0,i+1] := IntToStr(UserID);
108	StringGrid1.Cells[1,i+1] := IntToStr(GroupID);
109	StringGrid1.Cells[2,i+1] := UserName;
110	StringGrid1.Cells[3,i+1] := FirstName;
111	StringGrid1.Cells[4,i+1] := MiddleName;
112	StringGrid1.Cells[5,i+1] := LastName;
113	end;
114	end;
115	end;
116
117	procedure TListUsersForm.UpdateUser(row: integer);
118	begin
119	with IBSecurityService1 do
120	begin
121	UserID := StrToInt(StringGrid1.Cells[0,row]);
122	GroupID := StrToInt(StringGrid1.Cells[1,row]);
123	UserName := StringGrid1.Cells[2,row];
124	FirstName := StringGrid1.Cells[3,row];
125	MiddleName := StringGrid1.Cells[4,row];
126	LastName := StringGrid1.Cells[5,row];
127	ModifyUser
128	end;
129	end;
130
131	end.
132