⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 privilegefrm.~pas

📁 群星医药系统源码
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
{=======================================================================/
注意：
　　1.考虑到编程的稳定性及避免出现过于复杂的算法，角色列表不允许多选，
也就是说，不允许同时将多少角色一次授予某用户，只能一个一个的授予
/=======================================================================}
unit PrivilegeFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, RzPanel, RzSplit, Grids, ImgList, Menus, ComCtrls, ActnList,
  TFlatPanelUnit, VirtualTrees, TFlatButtonUnit, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, Db,
  Variants, DBClient, Tabs, StdCtrls, MConnect, DBGrids, xBaseFrm, ckDBClient, 
  ModuleAction,ceConst, uDataTypes, IMainFrm,uGlobal;

type
  PModuleData = ^TModuleData;
  TModuleData = record
    ModuleID:   Integer;
    ParentID:   Integer;
//    ModuleFile: WideString;
    MenuName:   WideString;
    Popedoms:   WideString;
    Remark:     WideString;
    Kind: 			Integer;
  end;

  TFmPrivilege = class(TxBaseForm)
    FlatPanel1: TRzSizePanel;
    RzSizePanel1: TRzSizePanel;
    Panel1: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    BtnUser: TFlatButton;
    vTreePriv: TVirtualStringTree;
    TabSet1: TTabSet;
    ActionList1: TActionList;
    RActNewUser: TModlAction;
    RActEditUser: TModlAction;
    RActDelUser: TModlAction;
    RActNewRole: TModlAction;
    RActEditRole: TModlAction;
    RActDelRole: TModlAction;
    RActExport: TModlAction;
    RActImport: TModlAction;
    DsUser: TDataSource;
    DsPrivRole: TDataSource;
    ImgStandard: TImageList;
    BtnRole: TFlatButton;
    pmUser: TPopupMenu;
    A1: TMenuItem;
    E1: TMenuItem;
    D1: TMenuItem;
    pmRole: TPopupMenu;
    MenuItem1: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    RzSizePanel2: TRzSizePanel;
    lvUserRole: TListView;
    plUserRole: TPanel;
    lvPrivRole: TListView;
    Panel5: TPanel;
    ImageList1: TImageList;
    ActMinimize: TAction;
    ActResume: TAction;
    lbCurrUser: TLabel;
    Panel2: TPanel;
    BtnCollapse: TFlatButton;
    BtnExpand: TFlatButton;
    BtnSave: TFlatButton;
    BtnCancel: TFlatButton;
    ImgUser: TImage;
    dbgUser: TDBGridEh;
    DcomConn: TDCOMConnection;
    cdsUsers: TckClientDataSet;
    cdsPrivRole: TckClientDataSet;
    cdsTemp: TckClientDataSet;
    cdsUserPriv: TckClientDataSet;
    cdsPrivRoleDtl: TckClientDataSet;
    cdsUserRealPriv: TckClientDataSet;
    cdsPrivModls: TckClientDataSet;
    cdsPrivModlsModuleID: TIntegerField;
    cdsPrivModlsParentID: TIntegerField;
    cdsPrivModlsMenuName: TStringField;
    cdsPrivModlsPopedoms: TStringField;
    cdsPrivModlsHasFile: TIntegerField;
    cdsPrivModlsRemark: TStringField;
    cdsUserRole: TckClientDataSet;
    cdsUsersUserID: TStringField;
    cdsUsersName: TStringField;
    cdsUsersDepartName: TStringField;
    cdsUsersPasswd: TStringField;
    cdsUsersDBScanRange: TSmallintField;
    cdsUsersDBModiRange: TSmallintField;
    cdsUsersReMark: TStringField;
    BtnCheckAll: TFlatButton;
    BtnCheckNone: TFlatButton;
    ActRoleRefresh: TModlAction;
    cdsPrivRolePrID: TIntegerField;
    cdsPrivRolePrName: TStringField;
    cdsPrivRoleReMark: TStringField;
    procedure vTreePrivResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BtnUserClick(Sender: TObject);
    procedure BtnRoleClick(Sender: TObject);
    procedure lvUserRoleDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure cdsUsersAfterScroll(DataSet: TDataSet);
    procedure lvPrivRoleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lvUserRoleDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TabSet1Change(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure vTreePrivGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vTreePrivBeforeItemErase(Sender: TBaseVirtualTree;
      Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
      var ItemColor: TColor; var EraseAction: TItemEraseAction);
    procedure vTreePrivInitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure vTreePrivChecked(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure dbgUserDblClick(Sender: TObject);
    procedure lvPrivRoleDblClick(Sender: TObject);
    procedure vTreePrivChecking(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean);
    procedure vTreePrivGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure vTreePrivMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure vTreePrivMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BtnCollapseClick(Sender: TObject);
    procedure BtnExpandClick(Sender: TObject);
    procedure lvUserRoleKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnSaveClick(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure RActNewRoleExecute(Sender: TObject);
    procedure RActEditRoleExecute(Sender: TObject);
    procedure RActDelRoleExecute(Sender: TObject);
    procedure cdsUserPrivReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure cdsUsersBeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
    procedure cdsUserPrivBeforeApplyUpdates(Sender: TObject;
      var OwnerData: OleVariant);
    procedure cdsUsersReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure RActEditUserExecute(Sender: TObject);
    procedure RActNewUserExecute(Sender: TObject);
    procedure RActDelUserExecute(Sender: TObject);
    procedure BtnCheckAllClick(Sender: TObject);
    procedure ActRoleRefreshExecute(Sender: TObject);
  private
    IFmMain: IMainForm;
    cdsPrivilege: TckClientDataSet;
    CurrUserID, CurrUserName: String; //当前显示的用户或角色ID
    bRole: Boolean;		//True:当前显示的是角色权限，false:当前显示的是用户权限
    bInitComplete: Boolean;//初始化权限节点完成
    TabModuleIDs: Array of Integer;
    LogonInfo: PLogonInfo;
    DropItem: TListItem;

    Procedure Init;
    procedure InitPrivRoles;
    procedure InitCurrUserPriv(UserID, UserName: String;
                               IsRole: Boolean; TabChanged: Boolean=false);
    procedure InitNodeCheckState(pNode: PVirtualNode);
		procedure AssignNodeData(Data: PModuleData; DataSet: TDataSet);
    procedure BuildChildNode(pNode: PVirtualNode);
    Function  GetPrivName(PrivChar: Char): String;
    procedure ResetNodeCheckState(Node: PVirtualNode);
    Procedure SetChildNodeCheckState(pNode: PVirtualNode; ckState: TCheckState);
    Function	SaveUserPrivChange(bNeedRefresh: Boolean): Integer;
  protected
    SvrSysManage: TDispatchConnection;
  public
    { Public declarations }
  end;

var
  FmPrivilege: TFmPrivilege;
  MouseState: TMouseButton;

implementation

uses RoleEdFrm, UserEdFrm;

{$R *.DFM}

const
  sqBuildUserPriv = 'SELECT ModuleID, PrivChar, Kind INTO %s FROM UserPriv_Table WHERE CompID=%d AND UserID=''%s'' AND Kind=1 '
							+'UNION SELECT R.ModuleID, R.PrivChar, U.Kind FROM PrivRoleDtl_Table R '
              +'JOIN UserPriv_Table U ON U.CompID=%d AND U.UserID=''%s'' AND R.PrID=U.ModuleID AND U.Kind=2 ';
  sqDelRepeatPriv = 'DELETE FROM %s WHERE KIND=1 AND EXISTS(SELECT 1 FROM %s B WHERE B.KIND=2 AND B.ModuleID=%s.ModuleID AND B.PrivChar=%s.PrivChar) ';

  sqBuildRolePriv = 'SELECT ModuleID, PrivChar, 1 Kind INTO %s FROM PrivRoleDtl_Table WHERE PrID=%s ';
  sqUserPriv = 'SELECT ModuleID, PrivChar, Kind FROM %s ';
//  sqGetPriv  = 'SELECT Kind FROM %s WHERE ModuleID=%d AND PrivChar=''%s'' Order By Kind DESC ';

  PressedCheckState = [csCheckedPressed, csUncheckedPressed, csMixedPressed];

procedure TFmPrivilege.FormCreate(Sender: TObject);
//var i, k: integer;
//    Comp: TComponent;
begin
{  k := self.ComponentCount;
  for i:=0 to k-1 do begin
    Comp := self.Components[i];
    if Comp is TckClientDataSet then
      (Comp as TckClientDataSet).Tag := IFmMain.IFmMainEx.ClientID;
  end;}
  IFmMain := Application.MainForm as IMainForm;
  SvrSysManage := IFmMain.GetConnection(Handle, '', 'ckSysManager.ModuleSetting');
  cdsTemp.RemoteServer := SvrSysManage;
  cdsUsers.RemoteServer := SvrSysManage;
  cdsUserPriv.RemoteServer := SvrSysManage;
  cdsUserRole.RemoteServer := SvrSysManage;
  cdsPrivRole.RemoteServer := SvrSysManage;
  cdsPrivRoleDtl.RemoteServer := SvrSysManage;
  cdsUserRealPriv.RemoteServer := SvrSysManage;

//  datasource1.DataSet := cdsPrivilege;

  bRole := false;
  bInitComplete := false;
  LogonInfo := IFmMain.IFmMainEx.LogonInfo;
end;

procedure TFmPrivilege.FormShow(Sender: TObject);
begin
  Inherited;
  cdsTemp.Close;
  cdsUsers.Close;
  cdsPrivRole.Close;
  cdsUserPriv.Close;
  dbgUser.SetFocus;
  cdsPrivRole.Open;
  Init;   //初始化需要权限管理的各模块（在其中调用 InitPrivRoles 过程载入角色）
  cdsUsers.Open;
end;

procedure TFmPrivilege.FormDestroy(Sender: TObject);
begin
//  cdsTemp.Connection.Execute(Format(sqDropTempPrivTb, [sTmpTbName, sTmpTbName]));
  Inherited;
end;

//将权限树大小改变时，自动调整最后一栏的宽度
procedure TFmPrivilege.vTreePrivResize(Sender: TObject);
var i, k, j: integer;
begin
  j := 0;
  k := vTreePriv.Header.Columns.Count;
  if k=0 then Exit;
  for i:=0 to k-2 do begin
    if coVisible in vTreePriv.Header.Columns[i].Options then
      Inc(j, vTreePriv.Header.Columns[i].Width);
  end;
  vTreePriv.Header.Columns[k-1].Width := vTreePriv.Width-j-20;
end;

procedure TFmPrivilege.BtnUserClick(Sender: TObject);
var pt: TPoint;
begin
	pt.x:=BtnUser.left;
	pt.y:=BtnUser.Top+BtnUser.Height+1;
	pt:=ClientToScreen(pt);
	pmUser.Popup(pt.x,pt.Y);
end;

procedure TFmPrivilege.BtnRoleClick(Sender: TObject);
var pt: TPoint;
begin
	pt.x:=BtnRole.left;
	pt.y:=BtnRole.Top+BtnRole.Height+1;
	pt:=ClientToScreen(pt);
	pmRole.Popup(pt.x,pt.Y);
end;

procedure TFmPrivilege.Init;
var i: Integer;
begin
  bInitComplete := false;
  TabSet1.Tabs.Clear;
  with cdsTemp do
  begin
    Close;
    CommandText := 'SELECT ModuleID, MENUNAME FROM ModuleSetting WHERE ParentID=0 AND HidePopedom=0 ORDER BY MenuIndex,ModuleID ';
    Open;
    SetLength(TabModuleIDs, RecordCount+1);
    TabSet1.Tabs.Add('价格体系授权');
    TabModuleIDs[0] := 0;
    i := 1;
    First;
    while not Eof do
    begin
      TabSet1.Tabs.Add(Fields[1].AsString);
      TabModuleIDs[i] := Fields[0].AsInteger;
      Inc(i);
      Next;
    end;
  end;
  InitPrivRoles;
  bInitComplete := true;
end;

//载入角色到ListView中
procedure TFmPrivilege.InitPrivRoles;
var Item: TListItem;
begin
  lvPrivRole.Items.Clear;
  with cdsPrivRole do begin
    Close;
    Open;
    First;
    while not Eof do begin
      Item := lvPrivRole.Items.Add;
      Item.Data := Pointer(Fields[0].AsInteger);
      Item.Caption := Fields[1].AsString;
      Next;
    end;
  end;
end;

procedure TFmPrivilege.lvUserRoleDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Source=lvPrivRole)and(not cdsUsers.IsEmpty);
end;

procedure TFmPrivilege.lvPrivRoleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DropItem := lvPrivRole.GetItemAt(x, y);
  if DropItem<>nil then
    lvPrivRole.BeginDrag(True);
end;

procedure TFmPrivilege.lvUserRoleDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var str, sUserID, sUserName: String;
    i, j, h, iPrID: Integer;
    Item: TListItem;
begin
  if DropItem=nil then Exit;
  sUserID := cdsUsers.Fields[0].AsString;
  sUserName := cdsUsers.Fields[1].AsString;
  if (CurrUserID=sUserID)and(SaveUserPrivChange(false)=-1) then
    Exit;
  str := '确定授予"'+sUserName+'"用户['+DropItem.Caption+']角色吗？';
  if Application.MessageBox(PChar(str), '确认', MB_YESNO+MB_ICONQUESTION)=IDNO THEN
    Exit;
  i := integer(DropItem.Data);
  h := lvUserRole.Items.Count;
  for j:=0 to h-1 do begin
    if Integer(lvUserRole.Items[j].Data)= i then begin
      str := '该用户已经授予了"'+DropItem.Caption+'"角色，角色不能重复授予！';
      Application.MessageBox(PChar(str), '消息', MB_ICONINFORMATION);
      Exit;
    end;
  end;
  iPrID := Integer(DropItem.Data);
  SvrSysManage.AppServer.AwardRoleToUser(IFmMain.IFmMainEx.ClientID, iPrID, sUserID);
  Item := lvUserRole.Items.Add;
  Item.Assign(DropItem);
  if CurrUserID=sUserID then begin
    cdsPrivilege.Refresh;
    vTreePriv.BeginUpdate;
    try
      InitNodeCheckState(nil);
    finally
      vTreePriv.EndUpdate;
    end;
  end;
end;

procedure TFmPrivilege.AssignNodeData(Data: PModuleData; DataSet: TDataSet);
begin
  with DataSet do begin
    Data^.ModuleID  := FieldByName('ModuleID').AsInteger;
    Data^.ParentID  := FieldByName('ParentID').AsInteger;
    Data^.MenuName  := FieldByName('MenuName').AsString;
    if FieldByName('HasFile').AsInteger=1 then begin
      Data^.Kind := -2;
      Data^.Popedoms  := FieldByName('Popedoms').AsString;
    end else begin
      Data^.Kind := -1;
      Data^.Popedoms  := '';
    end;
    Data^.Remark    := FieldByName('Remark').AsString;
  end;
end;

procedure TFmPrivilege.BuildChildNode(pNode: PVirtualNode);
const CkState: Array[0..2] of TCheckState= (csUncheckedNormal,csCheckedNormal,csCheckedPressed);
var i, k, iParentID: Integer;
    sPriv: String;
    FDataSet: TckClientDataSet;
    Node: PVirtualNode;
    NodeData, ParentData: PModuleData;
begin
  FDataSet := TckClientDataSet.Create(self);
  FDataSet.RemoteServer := SvrSysManage;
  FDataSet.ProviderName := 'dspPrivModls';
  if pNode=nil then begin
    iParentID := TabSet1.Tag;
    if iParentID=0 then//如果选中的是价格体系授权
    begin
      vTreePriv.Clear;
      with cdsTemp do
      begin
        Close;
        CommandText := 'select ModeNo, ModeName from PriceModes';
        Open;
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -