Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit AdministratorPageMain;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
- Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
- Vcl.ComCtrls, BidirectionalUserList, Vcl.Grids, StrUtils;
- const
- HEADER_IDUSER = '№';
- HEADER_FIRSTNAME = 'Фамилия';
- HEADER_LASTNAME = 'Имя';
- HEADER_PATRONYMIC = 'Отчество';
- HEADER_LOGIN = 'Логин';
- HEADER_PASSWORD = 'Пароль';
- HEADER_ROLEID = 'Роль';
- HEADER_PHONE = 'Телефон';
- HEADER_SEX = 'Пол';
- type
- TAdminFrameMain = class(TFrame)
- PageControl1: TPageControl;
- TabSheet1: TTabSheet;
- TabSheet2: TTabSheet;
- Label1: TLabel;
- UsersAmountLabel: TLabel;
- SGUsers: TStringGrid;
- BtnAdd: TButton;
- SGArchive: TStringGrid;
- DeletedUsersAmount: TLabel;
- Label4: TLabel;
- ButtonRecover: TButton;
- BtnDelete: TButton;
- BtnEdit: TButton;
- procedure FrameEnter(Sender: TObject);
- procedure BtnAddClick(Sender: TObject);
- procedure BtnEditClick(Sender: TObject);
- procedure BtnDeleteClick(Sender: TObject);
- procedure ButtonRecoverClick(Sender: TObject);
- procedure SGUsersSelectCell(Sender: TObject; ACol, ARow: Integer;
- var CanSelect: Boolean);
- procedure FillSGByFirstName(SG : TStringGrid; Text : String);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- implementation
- {$R *.dfm}
- uses ConstantsFile, AdministatorPageAddEdit, Main, ConstantsRole, EntityUser,
- ConstantsTitleMainFrame;
- procedure TAdminFrameMain.BtnAddClick(Sender: TObject);
- begin
- try
- with MainForm do
- begin
- Main.MainForm.LBCurrentPage.Caption := ConstantsTitleMainFrame.TITLE_ADD_USER_PAGE;
- AdminFrameMain.Visible := False;
- AdminFrameAdd.Visible := True;
- AdminFrameAdd.UpdateFrame;
- end;
- Except
- On E : EInOutError do
- begin
- Application.MessageBox('В доступе к файлу с пользователями отказано. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- On E : Exception do
- begin
- Application.MessageBox('Неизвестная ошибка. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- end;
- end;
- procedure FillHeadersSG(SGUsers : TStringGrid);
- begin
- SGUsers.Cells[0,0] := HEADER_IDUSER;
- SGUsers.Cells[1,0] := HEADER_FIRSTNAME;
- SGUsers.Cells[2,0] := HEADER_LASTNAME;
- SGUsers.Cells[3,0] := HEADER_PATRONYMIC;
- SGUsers.Cells[4,0] := HEADER_LOGIN;
- SGUsers.Cells[5,0] := HEADER_PASSWORD;
- SGUsers.Cells[6,0] := HEADER_ROLEID;
- SGUsers.Cells[7,0] := HEADER_PHONE;
- SGUsers.Cells[8,0] := HEADER_SEX;
- end;
- procedure ClearStringGrid(SG : TStringGrid);
- var
- I, J : Integer;
- begin
- for I := 0 to SG.RowCount - 1 do
- begin
- SG.Rows[I].Clear;
- end;
- end;
- procedure FillSpecificRole(SG : TStringGrid; Role : String);
- var
- TempList : TUserList;
- I, J : Integer;
- AmountDeletedUsers : Integer;
- begin
- ClearStringGrid(SG); // Очистка StringGrid
- FillHeadersSG(SG); // Заполнение заголовков StringGrid
- I := 1;
- J := 0;
- TempList := TUserList.GetUserListFromFile(ConstantsFile.FILE_NAME_USER); // Получение списка пользователей из типизированного файла
- AmountDeletedUsers := TUserList.GetAmountSpecificUsers(ConstantsFile.FILE_NAME_USER, ConstantsRole.ROLE_DELETED); // Количество удаленных пользователей
- MainForm.AdminFrameMain.DeletedUsersAmount.Caption := AmountDeletedUsers.ToString; // Вывод количества удаленных пользователей в компонент TLabel
- SG.RowCount := AmountDeletedUsers + 1;
- // Цикл для прохода по списку
- while TempList.Head <> NIL do
- begin
- // Заполнение полей StringGrid данными пользователя
- if TempList.Head^.User.Role = Role then // Если роль пользователя совпадает с ролью, переданной в эту процедуру
- begin
- SG.Cells[J, I] := TempList.Head.User.IdUser.ToString;
- SG.Cells[J + 1, I] := TempList.Head.User.FirstName;
- SG.Cells[J + 2, I] := TempList.Head.User.LastName;
- SG.Cells[J + 3, I] := TempList.Head.User.Patronymic;
- SG.Cells[J + 4, I] := TempList.Head.User.Login;
- SG.Cells[J + 5, I] := TempList.Head.User.Password;
- SG.Cells[J + 6, I] := TempList.Head.User.Role;
- SG.Cells[J + 7, I] := TempList.Head.User.Phone;
- SG.Cells[J + 8, I] := TempList.Head.User.Sex;
- Inc(I);
- end;
- TempList.Head := TempList.Head^.Next; // Переход к следующей записи
- end;
- end;
- procedure FillAllUsers(SG : TStringGrid);
- var
- AmountAllUsers : Integer;
- AmountDeletedUsers : Integer;
- AmountResult : Integer;
- TempList : TUserList;
- I, J : Integer;
- begin
- ClearStringGrid(SG); // Очистка SrtingGrid
- FillHeadersSG(SG); // Заполнение заголовков StringGrid
- I := 1;
- J := 0;
- TempList := TUserList.GetUserListFromFile(ConstantsFile.FILE_NAME_USER); // Получение списка пользователей из типизированного файла
- AmountAllUsers := TUserList.GetAmountAllUsers(ConstantsFile.FILE_NAME_USER); // Получение количества пользователей
- AmountDeletedUsers := TUserList.GetAmountSpecificUsers(ConstantsFile.FILE_NAME_USER, ConstantsRole.ROLE_DELETED); // Получение количества удаленных пользователей
- AmountResult := AmountAllUsers - AmountDeletedUsers; // Количество пользователей, кроме удаленных
- Main.MainForm.AdminFrameMain.UsersAmountLabel.Caption := AmountResult.ToString; // Вывод в компонент TLabel количества неудаленных пользователей
- SG.RowCount := AmountResult + 1;
- // Цикл для прохода по списку
- while TempList.Head <> NIL do
- begin
- if TempList.Head^.User.Role <> ConstantsRole.ROLE_DELETED then // Если пользователь не удален
- begin
- // Заполнение полей StringGrid данными пользователя
- SG.Cells[J, I] := TempList.Head.User.IdUser.ToString;
- SG.Cells[J + 1, I] := TempList.Head.User.FirstName;
- SG.Cells[J + 2, I] := TempList.Head.User.LastName;
- SG.Cells[J + 3, I] := TempList.Head.User.Patronymic;
- SG.Cells[J + 4, I] := TempList.Head.User.Login;
- SG.Cells[J + 5, I] := TempList.Head.User.Password;
- SG.Cells[J + 6, I] := TempList.Head.User.Role;
- SG.Cells[J + 7, I] := TempList.Head.User.Phone;
- SG.Cells[J + 8, I] := TempList.Head.User.Sex;
- Inc(I);
- end;
- TempList.Head := TempList.Head^.Next; // Переход к следующей записи
- end;
- TempList.Destroy; // Очистка памяти
- end;
- procedure TAdminFrameMain.BtnDeleteClick(Sender: TObject);
- Var
- C, R : Word;
- UserForDelete : TUser;
- TempList : TUserList;
- begin
- try
- C := SGUsers.Col; // Получить выбранный столбец в StringGrid
- R := SGUsers.Row; // Получить выбранную строку в StringGrid
- UserForDelete := TUserList.GetUserByPrimaryKey(SGUsers.Cells[0,R].ToInteger, ConstantsFile.FILE_NAME_USER); // Получить записи пользователя к удалению
- // Если ID выбранного пользователя совпадает с пользователем к удалению
- if UserForDelete.IdUser = Main.CurrentUser.IdUser then
- begin
- Application.MessageBox('Нельзя удалить свою учетную запись.','Отказ в удалении', MB_OK+MB_ICONERROR);
- exit;
- end;
- TempList := TUserList.GetUserListFromFile(ConstantsFile.FILE_NAME_USER); // Получить список пользователей из файла
- TempList.EditUserRoleById(SGUsers.Cells[0, R].ToInteger, ConstantsRole.ROLE_DELETED); // Присвоить выбранному пользователю роль "Удален"
- TempList.SaveUserList(ConstantsFile.FILE_NAME_USER); // Сохранение обновленного списка в файл
- Self.FrameEnter(Sender); // Обновление копонента TStringGrid после внесения правок
- TempList.Destroy; // Очистка памяти занятой динамической структурой
- Except
- On E : EInOutError do
- begin
- Application.MessageBox('В доступе к файлу с пользователями отказано. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- On E : Exception do
- begin
- Application.MessageBox('Неизвестная ошибка. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- end;
- end;
- Procedure SendDataForActions(SG : TStringGrid; TitleMainFrame : String);
- Var
- C, R : Word;
- UserForEdit : TUser;
- TempList : TUserList;
- begin
- C := SG.Col;
- R := SG.Row;
- UserForEdit := TUserList.GetUserByLogin(SG.Cells[4,R], ConstantsFile.FILE_NAME_USER);
- TempList := TUserList.GetUserListFromFile(ConstantsFile.FILE_NAME_USER);
- if UserForEdit <> NIL then
- TempList.DeleteUserByID(UserForEdit.IdUser);
- with MainForm do
- begin
- AdminFrameMain.Visible := False;
- AdminFrameAdd.Visible := True;
- AdminFrameAdd.UpdateFrameForEdit(UserForEdit);
- Main.MainForm.LBCurrentPage.Caption := TitleMainFrame;
- end;
- TempList.Destroy;
- end;
- procedure TAdminFrameMain.BtnEditClick(Sender: TObject);
- Var
- C, R : Word;
- UserForEdit : TUser;
- TempList : TUserList;
- begin
- try
- C := SGUsers.Col;
- R := SGUsers.Row;
- UserForEdit := TUserList.GetUserByPrimaryKey(SGUsers.Cells[0,R].ToInteger, ConstantsFile.FILE_NAME_USER);
- if UserForEdit.IdUser = Main.CurrentUser.IdUser then
- begin
- Application.MessageBox('Нельзя редактировать свою учетную запись.','Отказ в редактировании', MB_OK+MB_ICONERROR);
- exit;
- end;
- SendDataForActions(SGUsers, ConstantsTitleMainFrame.TITLE_EDIT_USER_PAGE);
- Except
- On E : EInOutError do
- begin
- Application.MessageBox('В доступе к файлу с пользователями отказано. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- On E : Exception do
- begin
- Application.MessageBox('Неизвестная ошибка. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- end;
- end;
- procedure TAdminFrameMain.ButtonRecoverClick(Sender: TObject);
- begin
- if SGArchive.RowCount - 1 = 0 then
- begin
- Application.MessageBox('Список удаленных пользователей пуст! Восстановление невозможно.','Ошибка восстановления',MB_OK+MB_ICONERROR)
- end
- else
- begin
- SendDataForActions(SGArchive, ConstantsTitleMainFrame.TITLE_RECOVER_USER_PAGE);
- end;
- end;
- function CheckSubStr(SubStr, MainStr: string): Boolean;
- begin
- Result := False;
- if (Pos(SubStr, MainStr) = 0) = False then Result := True;
- end;
- procedure TAdminFrameMain.FillSGByFirstName(SG : TStringGrid; Text : String);
- var
- I, J, Count : Integer;
- UserArray : array of array of String;
- Temp: String;
- begin
- if (SG.RowCount - 1 > 1) AND (Text <> '') then
- begin
- Text := Text.ToLower;
- Self.FrameEnter(NIL);
- Count := 0;
- SetLength(UserArray, SG.RowCount - 1, SG.ColCount);
- for I := 1 to SG.RowCount -1 do
- begin
- temp := SG.Cells[1,I].ToLower;
- if NOT(pos(text, temp)=0) then
- begin
- for J := 0 to SG.ColCount - 1 do
- begin
- UserArray[Count,J] := SG.Cells[J,I];
- end;
- Inc(Count);
- end;
- end;
- SetLength(UserArray,Count);
- SG.RowCount := Count + 1;
- for I := 0 to High(UserArray) do
- begin
- for J := 0 to High(UserArray[0]) do
- begin
- SG.Cells[J,I+1] := UserArray[I,J];
- end;
- end;
- end
- else if Text = '' then
- begin
- FrameEnter(NIL);
- end;
- end;
- procedure TAdminFrameMain.FrameEnter(Sender: TObject);
- begin
- try
- FillAllUsers(SGUsers);
- FillSpecificRole(SGArchive, ConstantsRole.ROLE_DELETED);
- Except
- On E : EInOutError do
- begin
- Application.MessageBox('В доступе к файлу с пользователями отказано. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- On E : Exception do
- begin
- Application.MessageBox('Неизвестная ошибка. Обратитесь к системному администратору.','Ошибка сохранения', MB_OK + MB_ICONERROR);
- Application.Terminate;
- Abort;
- end;
- end;
- end;
- procedure TAdminFrameMain.SGUsersSelectCell(Sender: TObject; ACol,
- ARow: Integer; var CanSelect: Boolean);
- begin
- CanSelect := True;
- if ARow = 0 then
- CanSelect := False;
- end;
- end.
Add Comment
Please, Sign In to add comment