Statistics
| Branch: | Tag: | Revision:

root / Client / UfrmAccountControl.pas @ 0:95bd93c28625

History | View | Annotate | Download (10.5 kB)

1
(*
2
 * CDDL HEADER START
3
 *
4
 * The contents of this file are subject to the terms of the
5
 * Common Development and Distribution License, Version 1.0 only
6
 * (the "License").  You may not use this file except in compliance
7
 * with the License.
8
 *
9
 * You can obtain a copy of the license at
10
 * http://www.opensource.org/licenses/cddl1.php.
11
 * See the License for the specific language governing permissions
12
 * and limitations under the License.
13
 *
14
 * When distributing Covered Code, include this CDDL HEADER in each
15
 * file and include the License file at
16
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
17
 * add the following below this CDDL HEADER, with the fields enclosed
18
 * by brackets "[]" replaced with your own identifying * information:
19
 *      Portions Copyright [yyyy] [name of copyright owner]
20
 *
21
 * CDDL HEADER END
22
 *
23
 *
24
 *      Portions Copyright 2007 Andreas Schneider
25
 *)
26
unit UfrmAccountControl;
27
28
{$mode objfpc}{$H+}
29
30
interface
31
32
uses
33
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
34
  VirtualTrees, VTHeaderPopup, UEnhancedMemoryStream, UEnums;
35
36
type
37
38
  { TfrmAccountControl }
39
40
  TfrmAccountControl = class(TForm)
41
    ilToolbar: TImageList;
42
    ilAccesslevel: TImageList;
43
    tbMain: TToolBar;
44
    tbRefresh: TToolButton;
45
    tbAddUser: TToolButton;
46
    tbEditUser: TToolButton;
47
    tbDeleteUser: TToolButton;
48
    tbSeparator1: TToolButton;
49
    vstAccounts: TVirtualStringTree;
50
    procedure tbEditUserClick(Sender: TObject);
51
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
52
    procedure FormCreate(Sender: TObject);
53
    procedure FormDestroy(Sender: TObject);
54
    procedure FormShow(Sender: TObject);
55
    procedure tbAddUserClick(Sender: TObject);
56
    procedure tbDeleteUserClick(Sender: TObject);
57
    procedure tbRefreshClick(Sender: TObject);
58
    procedure vstAccountsDblClick(Sender: TObject);
59
    procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
60
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
61
      var Ghosted: Boolean; var ImageIndex: Integer);
62
    procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
63
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
64
  protected
65
    procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
66
    procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
67
    procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
68
    function FindNode(AUsername: string): PVirtualNode;
69
  public
70
    { public declarations }
71
  end;
72
73
var
74
  frmAccountControl: TfrmAccountControl;
75
76
implementation
77
78
uses
79
  UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount;
80
81
type
82
  PAccountInfo = ^TAccountInfo;
83
  TAccountInfo = record
84
    Username: string;
85
    AccessLevel: TAccessLevel;
86
  end;
87
  
88
  { TModifyUserPacket }
89
90
  TModifyUserPacket = class(TPacket)
91
    constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel);
92
  end;
93
  
94
  { TDeleteUserPacket }
95
96
  TDeleteUserPacket = class(TPacket)
97
    constructor Create(AUsername: string);
98
  end;
99
  
100
  { TRequestUserListPacket }
101
102
  TRequestUserListPacket = class(TPacket)
103
    constructor Create;
104
  end;
105
106
{ TModifyUserPacket }
107
108
constructor TModifyUserPacket.Create(AUsername, APassword: string;
109
  AAccessLevel: TAccessLevel);
110
begin
111
  inherited Create($03, 0);
112
  FStream.WriteByte($05);
113
  FStream.WriteStringNull(AUsername);
114
  FStream.WriteStringNull(APassword);
115
  FStream.WriteByte(Byte(AAccessLevel));
116
end;
117
118
{ TDeleteUserPacket }
119
120
constructor TDeleteUserPacket.Create(AUsername: string);
121
begin
122
  inherited Create($03, 0);
123
  FStream.WriteByte($06);
124
  FStream.WriteStringNull(AUsername);
125
end;
126
127
{ TRequestUserListPacket }
128
129
constructor TRequestUserListPacket.Create;
130
begin
131
  inherited Create($03, 0);
132
  FStream.WriteByte($07);
133
end;
134
135
{ TfrmAccountControl }
136
137
procedure TfrmAccountControl.FormCreate(Sender: TObject);
138
begin
139
  vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
140
  
141
  AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserResponse);
142
  AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserResponse);
143
  AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
144
end;
145
146
procedure TfrmAccountControl.FormClose(Sender: TObject;
147
  var CloseAction: TCloseAction);
148
begin
149
  CloseAction := caHide;
150
end;
151
152
procedure TfrmAccountControl.tbEditUserClick(Sender: TObject);
153
var
154
  selected: PVirtualNode;
155
  accountInfo: PAccountInfo;
156
begin
157
  selected := vstAccounts.GetFirstSelected;
158
  if selected <> nil then
159
  begin
160
    accountInfo := vstAccounts.GetNodeData(selected);
161
    with frmEditAccount do
162
    begin
163
      edUsername.Text := accountInfo^.Username;
164
      edUsername.Color := clBtnFace;
165
      edUsername.ReadOnly := True;
166
      edPassword.Text := '';
167
      lblPasswordHint.Visible := True;
168
      SetAccessLevel(accountInfo^.AccessLevel);
169
      if ShowModal = mrOK then
170
        dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text, GetAccessLevel));
171
    end;
172
  end;
173
end;
174
175
procedure TfrmAccountControl.FormDestroy(Sender: TObject);
176
begin
177
  if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]);
178
  if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]);
179
  if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]);
180
end;
181
182
procedure TfrmAccountControl.FormShow(Sender: TObject);
183
begin
184
  tbRefreshClick(Sender);
185
end;
186
187
procedure TfrmAccountControl.tbAddUserClick(Sender: TObject);
188
begin
189
  with frmEditAccount do
190
  begin
191
    edUsername.Text := '';
192
    edUsername.Color := clWindow;
193
    edUsername.ReadOnly := False;
194
    edPassword.Text := '';
195
    lblPasswordHint.Visible := False;
196
    cbAccessLevel.ItemIndex := 2;
197
    if ShowModal = mrOK then
198
      dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text, GetAccessLevel));
199
  end;
200
end;
201
202
procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject);
203
var
204
  selected: PVirtualNode;
205
  accountInfo: PAccountInfo;
206
begin
207
  selected := vstAccounts.GetFirstSelected;
208
  if selected <> nil then
209
  begin
210
    accountInfo := vstAccounts.GetNodeData(selected);
211
    if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?', [accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
212
      dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username));
213
  end;
214
end;
215
216
procedure TfrmAccountControl.tbRefreshClick(Sender: TObject);
217
begin
218
  dmNetwork.Send(TRequestUserListPacket.Create);
219
end;
220
221
procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject);
222
begin
223
  tbEditUserClick(Sender);
224
end;
225
226
procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
227
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
228
  var Ghosted: Boolean; var ImageIndex: Integer);
229
var
230
  accountInfo: PAccountInfo;
231
begin
232
  if Column = 0 then
233
  begin
234
    accountInfo := Sender.GetNodeData(Node);
235
    case accountInfo^.AccessLevel of
236
      alNone: ImageIndex := 0;
237
      alView: ImageIndex := 1;
238
      alNormal: ImageIndex := 2;
239
      alAdministrator: ImageIndex := 3;
240
    end;
241
  end;
242
end;
243
244
procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree;
245
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
246
  var CellText: WideString);
247
var
248
  accountInfo: PAccountInfo;
249
begin
250
  accountInfo := Sender.GetNodeData(Node);
251
  case Column of
252
    1: CellText := accountInfo^.Username;
253
    2: CellText := GetAccessLevelString(accountInfo^.AccessLevel);
254
  else
255
    CellText := '';
256
  end;
257
end;
258
259
procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
260
var
261
  node: PVirtualNode;
262
  modifyStatus: TModifyUserStatus;
263
  username: string;
264
  accountInfo: PAccountInfo;
265
begin
266
  modifyStatus := TModifyUserStatus(ABuffer.ReadByte);
267
  username := ABuffer.ReadStringNull;
268
  case modifyStatus of
269
    muAdded:
270
      begin
271
        node := vstAccounts.AddChild(nil);
272
        accountInfo := vstAccounts.GetNodeData(node);
273
        accountInfo^.Username := username;
274
        accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
275
        Messagedlg('Success', Format('The user "%s" has been added.', [username]), mtInformation, [mbOK], 0);
276
      end;
277
    muModified:
278
      begin
279
        node := FindNode(username);
280
        if node <> nil then
281
        begin
282
          accountInfo := vstAccounts.GetNodeData(node);
283
          accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
284
          Messagedlg('Success', Format('The user "%s" has been modified.', [username]), mtInformation, [mbOK], 0);
285
        end;
286
      end;
287
    muInvalidUsername:
288
      MessageDlg('Error', Format('The username "%s" is not valid.', [username]), mtError, [mbOK], 0);
289
  end;
290
end;
291
292
procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
293
var
294
  node: PVirtualNode;
295
  deleteStatus: TDeleteUserStatus;
296
  username: string;
297
begin
298
  deleteStatus := TDeleteUserStatus(ABuffer.ReadByte);
299
  username := ABuffer.ReadStringNull;
300
  case deleteStatus of
301
    duDeleted:
302
      begin
303
        node := FindNode(username);
304
        if node <> nil then
305
        begin
306
          vstAccounts.DeleteNode(node);
307
          Messagedlg('Success', Format('The user "%s" has been deleted.', [username]), mtInformation, [mbOK], 0);
308
        end;
309
      end;
310
    duNotFound:
311
      MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe your list is out of date or you tried to delete yourself.', [username]), mtError, [mbOK], 0);
312
  end;
313
end;
314
315
procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
316
var
317
  node: PVirtualNode;
318
  accountInfo: PAccountInfo;
319
  i, count: Word;
320
begin
321
  vstAccounts.BeginUpdate;
322
  vstAccounts.Clear;
323
  count := ABuffer.ReadWord;
324
  for i := 1 to count do
325
  begin
326
    node := vstAccounts.AddChild(nil);
327
    accountInfo := vstAccounts.GetNodeData(node);
328
    accountInfo^.Username := ABuffer.ReadStringNull;
329
    accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
330
  end;
331
  vstAccounts.EndUpdate;
332
end;
333
334
function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode;
335
var
336
  node: PVirtualNode;
337
  accountInfo: PAccountInfo;
338
begin
339
  Result := nil;
340
  node := vstAccounts.GetFirst;
341
  while (node <> nil) and (Result = nil) do
342
  begin
343
    accountInfo := vstAccounts.GetNodeData(node);
344
    if accountInfo^.Username = AUsername then
345
      Result := node;
346
    node := vstAccounts.GetNext(node);
347
  end;
348
end;
349
350
initialization
351
  {$I UfrmAccountControl.lrs}
352
353
end.
354