unit U_UsersEditor; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, RzButton, RzPanel, ExtCtrls, siComp, siLngLnk, U_BaseCommon, U_BaseConstants, U_SCSComponent, U_SCSClasses, U_SCSLists, U_ProtectionBase, exgrid, RapTree, FlytreePro, DBFTree, DB, kbmMemTable, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, ComCtrls, ToolWin, cxGridLevel, cxClasses, cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, cxTextEdit, cxButtonEdit, cxDBLookupComboBox, ActnList, ImgList, Menus, XPMenu, cxCheckBox, cxCurrencyEdit, cxColorComboBox, cxSpinEdit, cxMemo, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator; type TF_UsersEditor = class(TForm) RzPanel1: TRzPanel; gbOkCancel: TRzGroupBox; btOk: TRzBitBtn; btCancel: TRzBitBtn; lng_Forms: TsiLangLinked; mtUsers: TkbmMemTable; dsrcUsers: TDataSource; gtUsers: TcxGridDBTableView; glUsers: TcxGridLevel; gridUsers: TcxGrid; ToolBar1: TToolBar; ToolButton1: TToolButton; ToolButton3: TToolButton; gtUsersName: TcxGridDBColumn; gtUsersPassStatus: TcxGridDBColumn; gtUsersRightsPM: TcxGridDBColumn; gtUsersRightsNB: TcxGridDBColumn; mtUserRightsPM: TkbmMemTable; dsrcUserRightsPM: TDataSource; dsrcUserRightsNB: TDataSource; mtUserRightsNB: TkbmMemTable; ActionList: TActionList; ImageList1: TImageList; Act_AddUser: TAction; Act_DelUser: TAction; PopupMenu1: TPopupMenu; ActAddUser1: TMenuItem; ActDelUser1: TMenuItem; gtUsersPass: TcxGridDBColumn; pnNotice: TRzPanel; lbNotice: TLabel; RzPanel2: TRzPanel; Timer_ChangeUerPass: TTimer; Timer_PostUser: TTimer; ToolButton2: TToolButton; Act_AddUsersFromBase: TAction; Importdefaultusers1: TMenuItem; pnCurrUserInfo: TRzPanel; Label1: TLabel; lbCurrentUser: TLabel; Label2: TLabel; XPMenu: TXPMenu; procedure FormCreate(Sender: TObject); procedure gtUsersPassPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure gtUsersPassStatusGetDisplayText(Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure gbOkCancelResize(Sender: TObject); procedure Act_AddUserExecute(Sender: TObject); procedure Act_DelUserExecute(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure gtUsersNamePropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure gtUsersPassStatusPropertiesChange(Sender: TObject); procedure gtUsersFocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); procedure mtUsersAfterInsert(DataSet: TDataSet); procedure mtUsersAfterEdit(DataSet: TDataSet); procedure Timer_ChangeUerPassTimer(Sender: TObject); procedure Timer_PostUserTimer(Sender: TObject); procedure gtUsersEditValueChanged(Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); procedure Act_AddUsersFromBaseExecute(Sender: TObject); private GForm: TForm; FDeletedIDs: TIntList; FNoDelUserNames: TStringList; FTimerChangeUerPasHandling: Boolean; procedure AddUserToMemTable(AUserInfo: TUserInfo; AUseObjectAddress: Boolean); function GetUniqUserName: String; function GetUsrNamesUpper: TStringList; procedure SetControlsToRecord; procedure SetControls; public Constructor Create(AOwner: TComponent; AForm: TForm); Destructor Destroy; override; function Execute(AUsersInfo: TUsersInfo; AForProjMan: Boolean; ACurrUserName, ANotice: String; ANoDelUserNames: TStringList=nil): Boolean; end; function ShowUsers(AUsersInfo: TUsersInfo; AForProjMan: Boolean; ACurrUserName, ANotice: String; ANoDelUserNames: TStringList=nil): Boolean; //var // Form1: TForm1; implementation Uses U_MakeEditPass, U_Main; {$R *.dfm} constructor TF_UsersEditor.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; inherited Create(AOwner); end; destructor TF_UsersEditor.Destroy; begin inherited; end; procedure TF_UsersEditor.AddUserToMemTable(AUserInfo: TUserInfo; AUseObjectAddress: Boolean); begin mtUsers.Append; mtUsers.FieldByName(fnID).AsInteger := AUserInfo.ID; mtUsers.FieldByName(fnName).AsString := AUserInfo.Name; mtUsers.FieldByName(fnPass).AsString := AUserInfo.Pass; mtUsers.FieldByName(fnRightsPM).AsInteger := AUserInfo.RightsPM; mtUsers.FieldByName(fnRightsNB).AsInteger := AUserInfo.RightsNB; if AUseObjectAddress then mtUsers.FieldByName(fnObjectAddress).AsInteger := Integer(AUserInfo) else mtUsers.FieldByName(fnObjectAddress).AsInteger := 0; mtUsers.Post; end; function TF_UsersEditor.GetUniqUserName: String; var UserNames: TStringList; UsrName: String; UsrIndex: Integer; begin Result := ''; UserNames := GetUsrNamesUpper; try UsrIndex := 0; while Result = '' do begin UsrName := 'User'; if UsrIndex > 0 then UsrName := UsrName + IntToStr(UsrIndex); if UserNames.IndexOf(AnsiUpperCase(UsrName)) = -1 then Result := UsrName; Inc(UsrIndex); end; finally UserNames.Free; end; end; function TF_UsersEditor.GetUsrNamesUpper: TStringList; var //StrBookmark: string; StrBookmark: TBookMark; FieldIndex: Integer; begin Result := TStringList.Create; FieldIndex := mtUsers.FieldDefs.IndexOf(fnName); if FieldIndex <> -1 then begin mtUsers.DisableControls; //StrBookmark := mtUsers.Bookmark; StrBookmark := mtUsers.GetBookmark; try mtUsers.First; while Not mtUsers.Eof do begin Result.Add(AnsiUpperCase(mtUsers.Fields[FieldIndex].AsString)); mtUsers.Next; end; if StrBookMark <> nil then begin mtUsers.GotoBookmark(StrBookmark); mtUsers.FreeBookmark(StrBookmark); end; finally mtUsers.EnableControls; end; end; end; procedure TF_UsersEditor.SetControlsToRecord; var IsEditingFields: Boolean; begin if mtUsers.Active then begin IsEditingFields := FNoDelUserNames.IndexOf(AnsiUpperCase(mtUsers.FieldByName(fnName).AsString)) = -1; gtUsersName.Options.Editing := IsEditingFields; gtUsersRightsPM.Options.Editing := IsEditingFields; gtUsersRightsNB.Options.Editing := IsEditingFields; end; end; procedure TF_UsersEditor.SetControls; begin try Act_DelUser.Enabled := (mtUsers.Active) and (mtUsers.RecordCount > 0); except on E: Exception do AddExceptionToLogEx('TF_UsersEditor.SetControls', E.Message); end; end; function TF_UsersEditor.Execute(AUsersInfo: TUsersInfo; AForProjMan: Boolean; ACurrUserName, ANotice: String; ANoDelUserNames: TStringList=nil): Boolean; var i: Integer; UserInfo: TUserInfo; //BookmarkStr: String; BookmarkStr: TBookMark; begin Result := false; try mtUsers.Active := false; mtUsers.Active := true; if AForProjMan then begin Caption := cUsersEditor6_1; gtUsersRightsPM.Caption := cUsersEditor7_1; TcxLookupComboBoxProperties(gtUsersRightsPM.Properties).ListSource := dsrcUserRightsPM; end else begin Caption := cUsersEditor6_2; gtUsersRightsPM.Caption := cUsersEditor7_2; //*** НРа проекте не юзать права админа TcxLookupComboBoxProperties(gtUsersRightsPM.Properties).ListSource := dsrcUserRightsNB; end; // Панель с активным юзером pnCurrUserInfo.Visible := (ACurrUserName <> ''); lbCurrentUser.Caption := ACurrUserName; // Панель с примечанием pnNotice.Visible := ANotice <> ''; if ANotice <> '' then begin lbNotice.Caption := ANotice; end; gtUsersRightsNB.Visible := AForProjMan; Act_AddUsersFromBase.Visible := Not AForProjMan; //*** Вкинуть зверей в MemTable //BookmarkStr := ''; BookmarkStr := Nil; mtUsers.AfterInsert := nil; mtUsers.DisableControls; try for i := 0 to AUsersInfo.UsersInfo.Count - 1 do begin UserInfo := TUserInfo(AUsersInfo.UsersInfo[i]); AddUserToMemTable(UserInfo, true); if ACurrUserName <> '' then if AnsiUpperCase(UserInfo.Name) = AnsiUpperCase(ACurrUserName) then //BookmarkStr := mtUsers.Bookmark; BookmarkStr := mtUsers.GetBookmark; end; finally mtUsers.EnableControls; end; mtUsers.AfterInsert := mtUsersAfterInsert; if mtUsers.RecordCount > 0 then mtUsers.First; {if BookmarkStr <> '' then mtUsers.Bookmark := BookmarkStr;} if BookmarkStr <> nil then begin mtUsers.GotoBookmark(BookmarkStr); mtUsers.FreeBookmark(BookmarkStr); end; FNoDelUserNames.Clear; if ANoDelUserNames <> nil then for i := 0 to ANoDelUserNames.Count - 1 do FNoDelUserNames.Add(AnsiUpperCase(ANoDelUserNames[i])); FDeletedIDs.Clear; SetControls; SetControlsToRecord; if ShowModal = mrOk then begin Result := True; //*** Удалить удаленных пользователей for i := 0 to FDeletedIDs.Count - 1 do AUsersInfo.UsersInfo.Remove(TObject(FDeletedIDs[i])); //*** Внести зменения mtUsers.DisableControls; try mtUsers.First; while Not mtUsers.Eof do begin UserInfo := nil; if mtUsers.FieldByName(fnIsModified).AsBoolean and (mtUsers.FieldByName(fnObjectAddress).AsInteger <> 0) then UserInfo := TUserInfo(mtUsers.FieldByName(fnObjectAddress).AsInteger) else if mtUsers.FieldByName(fnIsNew).AsBoolean then UserInfo := AUsersInfo.AddNewUserInfo('', '', 0, 0); if UserInfo <> nil then begin UserInfo.Name := mtUsers.FieldByName(fnName).AsString; UserInfo.Pass := mtUsers.FieldByName(fnPass).AsString; UserInfo.RightsPM := mtUsers.FieldByName(fnRightsPM).AsInteger; UserInfo.RightsNB := mtUsers.FieldByName(fnRightsNB).AsInteger; end; mtUsers.Next; end; finally mtUsers.EnableControls; end; end; mtUsers.Active := false; except on E: Exception do AddExceptionToLogEx('TF_UsersEditor.Execute', E.Message); end; end; procedure TF_UsersEditor.FormCreate(Sender: TObject); var Action: TAction; i: Integer; begin mtUsers.FieldDefs.Add(fnID, ftInteger); mtUsers.FieldDefs.Add(fnName, ftString, 255); mtUsers.FieldDefs.Add(fnPass, ftString, 255); mtUsers.FieldDefs.Add(fnPassStatus, ftString, 255); mtUsers.FieldDefs.Add(fnRightsPM, ftInteger); mtUsers.FieldDefs.Add(fnRightsNB, ftInteger); mtUsers.FieldDefs.Add(fnObjectAddress, ftInteger); mtUsers.FieldDefs.Add(fnIsNew, ftBoolean); mtUsers.FieldDefs.Add(fnIsModified, ftBoolean); mtUserRightsPM.FieldDefs.Add(fnID, ftInteger); mtUserRightsPM.FieldDefs.Add(fnName, ftString, 50); mtUserRightsPM.Active := true; mtUserRightsPM.Append; mtUserRightsPM.FieldByName(fnID).AsInteger := rwrRead; mtUserRightsPM.FieldByName(fnName).AsString := cNameRightReadB; mtUserRightsPM.Post; mtUserRightsPM.Append; mtUserRightsPM.FieldByName(fnID).AsInteger := rwrReadWrite; mtUserRightsPM.FieldByName(fnName).AsString := cNameRightReadWriteB; mtUserRightsPM.Post; AssignMemTable(mtUserRightsNB, mtUserRightsPM, true); mtUserRightsPM.Append; mtUserRightsPM.FieldByName(fnID).AsInteger := rwrAdmin; mtUserRightsPM.FieldByName(fnName).AsString := cNameRightAdminB; mtUserRightsPM.Post; gbOkCancelResize(gbOkCancel); FDeletedIDs := TIntList.Create; FNoDelUserNames := TStringList.Create; FTimerChangeUerPasHandling := false; Constraints.MinHeight := 295; Constraints.MinWidth := 495; // Hints for actions for i := 0 to ActionList.ActionCount - 1 do begin Action := TAction(ActionList.Actions[i]); Action.Hint := Action.Caption; Action.HelpType := htContext; end; end; procedure TF_UsersEditor.FormDestroy(Sender: TObject); begin FreeAndNil(FDeletedIDs); FreeAndNil(FNoDelUserNames); end; procedure TF_UsersEditor.gtUsersPassPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); var CurrPass, NewPass: String; begin try CurrPass := ''; if FNoDelUserNames.IndexOf(AnsiUpperCase(mtUsers.FieldByName(fnName).AsString)) <> -1 then CurrPass := mtUsers.FieldByName(fnPass).AsString; NewPass := GetNewPass(CurrPass); if NewPass <> '' then begin mtUsers.Edit; mtUsers.FieldByName(fnPass).AsString := NewPass; mtUsers.Post; end; except on E: Exception do AddExceptionToLogEx('TF_UsersEditor.gtUsersPassPropertiesButtonClick', E.Message); end; end; procedure TF_UsersEditor.gtUsersPassStatusGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin //if ARecord.Values[gtUsersPass.Index] <> '' then // AText := cUsersEditor1_1 // else // AText := cUsersEditor1_2; AText := cUsersEditor3; end; procedure TF_UsersEditor.gbOkCancelResize(Sender: TObject); begin SetMiddleControlChilds(TControl(Sender), TControl(Self)); end; procedure TF_UsersEditor.Act_AddUserExecute(Sender: TObject); var NewUserName: String; begin try NewUserName := GetUniqUserName; mtUsers.Append; mtUsers.FieldByName(fnName).AsString := NewUserName; mtUsers.FieldByName(fnPass).AsString := GetHash(''); mtUsers.FieldByName(fnRightsPM).AsInteger := rwrReadWrite; mtUsers.FieldByName(fnRightsNB).AsInteger := rwrReadWrite; mtUsers.FieldByName(fnObjectAddress).AsInteger := 0; mtUsers.Post; SetControls; except on E: Exception do AddExceptionToLogEx('TF_UsersEditor.Act_AddUserExecute', E.Message); end; end; procedure TF_UsersEditor.Act_DelUserExecute(Sender: TObject); begin if FNoDelUserNames.IndexOf(AnsiUpperCase(mtUsers.FieldByName(fnName).AsString)) <> -1 then MessageModal(cUsersEditor5, ApplicationName, MB_OK or MB_ICONINFORMATION) else if MessageModal(cUsersEditor4, ApplicationName, MB_YESNO or MB_ICONQUESTION) = IDYES then begin if mtUsers.FieldByName(fnObjectAddress).AsInteger <> 0 then FDeletedIDs.Add(mtUsers.FieldByName(fnObjectAddress).AsInteger); mtUsers.Delete; SetControls; end; end; procedure TF_UsersEditor.gtUsersNamePropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var UserNames: TStringList; begin if DisplayValue <> '' then begin UserNames := GetUsrNamesUpper; try if UserNames.IndexOf(AnsiUpperCase(DisplayValue)) <> -1 then begin MessageModal(cUsersEditor2, ApplicationName, MB_OK or MB_ICONEXCLAMATION); DisplayValue := mtUsers.FieldByName(fnName).AsString; end else begin TcxTextEdit(Sender).Properties.OnValidate := nil; try mtUsers.Edit; mtUsers.FieldByName(fnName).AsString := DisplayValue; mtUsers.Post; finally TcxTextEdit(Sender).Properties.OnValidate := gtUsersNamePropertiesValidate; end; end; finally FreeAndNil(UserNames); end; end else begin DisplayValue := mtUsers.FieldByName(fnName).AsString; end; end; procedure TF_UsersEditor.gtUsersPassStatusPropertiesChange( Sender: TObject); begin if Not FTimerChangeUerPasHandling then Timer_ChangeUerPass.Enabled := true; end; procedure TF_UsersEditor.gtUsersFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); begin SetControlsToRecord; end; procedure TF_UsersEditor.mtUsersAfterInsert(DataSet: TDataSet); begin if DataSet.State = dsInsert then DataSet.FieldByName(fnIsNew).AsBoolean := true; end; procedure TF_UsersEditor.mtUsersAfterEdit(DataSet: TDataSet); begin if DataSet.State = dsEdit then DataSet.FieldByName(fnIsModified).AsBoolean := true; end; function ShowUsers(AUsersInfo: TUsersInfo; AForProjMan: Boolean; ACurrUserName, ANotice: String; ANoDelUserNames: TStringList=nil): Boolean; var F_UsersEditor: TF_UsersEditor; begin Result := false; F_UsersEditor := TF_UsersEditor.Create(F_ProjMan, F_ProjMan); try Result := F_UsersEditor.Execute(AUsersInfo, AForProjMan, ACurrUserName, ANotice, ANoDelUserNames); finally FreeAndNil(F_UsersEditor); end; end; procedure TF_UsersEditor.Timer_ChangeUerPassTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; FTimerChangeUerPasHandling := true; try gtUsersPassPropertiesButtonClick(nil, 0); finally FTimerChangeUerPasHandling := false; end; end; procedure TF_UsersEditor.Timer_PostUserTimer(Sender: TObject); begin if IsOtherTimerToHandleInOrder(TTimer(Sender)) then Exit; ///// EXIT ///// EnableTimerWithOrder(TTimer(Sender), false); if gtUsers.DataController.IsEditing and (mtUsers.State <> dsBrowse) then begin gtUsers.DataController.Post; // Админ не может работать с базой в режиме чтения if (mtUsers.FieldByName(fnRightsPM).AsInteger = rwrAdmin) and (mtUsers.FieldByName(fnRightsNB).AsInteger <> rwrReadWrite) then begin mtUsers.Edit; mtUsers.FieldByName(fnRightsNB).AsInteger := rwrReadWrite; mtUsers.Post; end; end; end; procedure TF_UsersEditor.gtUsersEditValueChanged( Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); begin if Sender.DataController.IsEditing and (mtUsers.State <> dsBrowse) then EnableTimerWithOrder(Timer_PostUser, true, true); end; procedure TF_UsersEditor.Act_AddUsersFromBaseExecute(Sender: TObject); var PMUsersInfo: TUsersInfo; PMUserInfo: TUserInfo; NewUserInfo: TUserInfo; CurrUsrNames: TStringList; i: Integer; begin try PMUsersInfo := TF_Main(GForm).DM.UsersInfoPM; CurrUsrNames := GetUsrNamesUpper; NewUserInfo := TUserInfo.Create; mtUserRightsPM.DisableControls; try for i := 0 to PMUsersInfo.UsersInfo.Count - 1 do begin PMUserInfo := TUserInfo(PMUsersInfo.UsersInfo[i]); // Если нету такого юзера, то добавить его из базы if CurrUsrNames.IndexOf(AnsiUpperCase(PMUserInfo.Name)) = -1 then begin NewUserInfo.Assign(PMUserInfo); if NewUserInfo.RightsPM = rwrAdmin then NewUserInfo.RightsPM := rwrReadWrite; AddUserToMemTable(NewUserInfo, false); end; end; finally mtUserRightsPM.EnableControls; end; FreeAndNil(NewUserInfo); FreeAndNil(CurrUsrNames); except on E: Exception do AddExceptionToLogEx('TF_UsersEditor.Act_AddUsersFromBaseExecute', E.Message); end; end; end.