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

📄 main.pas

📁 权限管理
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList, Menus, Db, DBClient, StdCtrls, Buttons, ComCtrls, ToolWin,
  ExtCtrls, Grids, DBGrids, ADODB;

type
  TFrmMain = class(TForm)
    StatusBar1: TStatusBar;
    PageCtrlPur: TPageControl;
    TabSheetUser: TTabSheet;
    Splitter1: TSplitter;
    Panel1: TPanel;
    Panel3: TPanel;
    BtnNewUser: TButton;
    BtnDelUser: TButton;
    DBGridUser: TDBGrid;
    Panel2: TPanel;
    GroupBox2: TGroupBox;
    DBGridUserIncPost: TDBGrid;
    DBGridUserExPost: TDBGrid;
    Panel4: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    GroupBox3: TGroupBox;
    DBGridUserIncPur: TDBGrid;
    TabSheetPost: TTabSheet;
    Splitter2: TSplitter;
    Panel6: TPanel;
    GroupBox4: TGroupBox;
    Panel8: TPanel;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    DBGridPostIncGroup: TDBGrid;
    DBGridPostExGroup: TDBGrid;
    GroupBox5: TGroupBox;
    DBGridPostIncPur: TDBGrid;
    Panel5: TPanel;
    Panel7: TPanel;
    BtnNewPost: TButton;
    BtnDelPost: TButton;
    DBGridPost: TDBGrid;
    TabSheetGroup: TTabSheet;
    Splitter3: TSplitter;
    Panel9: TPanel;
    Panel11: TPanel;
    BtnNewGroup: TButton;
    BtnDelGroup: TButton;
    DBGridGroup: TDBGrid;
    Panel10: TPanel;
    Panel12: TPanel;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    DBGridGroupIncPur: TDBGrid;
    DBGridGroupExPur: TDBGrid;
    procedure FormShow(Sender: TObject);
    //权限组
    procedure DSLocalGroupDataChange(Sender: TObject; Field: TField);
    //用户添加角色
    procedure SpeedButton1Click(Sender: TObject);
    procedure DBGridUserExPostDblClick(Sender: TObject);
    procedure DBGridUserExPostKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGridUserExPostCellClick(Column: TColumn);
    //用户删除角色
    procedure SpeedButton2Click(Sender: TObject);
    procedure DBGridUserIncPostDblClick(Sender: TObject);
    procedure DBGridUserIncPostKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGridUserIncPostCellClick(Column: TColumn);
    //角色添加权限组
    procedure SpeedButton3Click(Sender: TObject);
    procedure DBGridPostExGroupDblClick(Sender: TObject);
    procedure DBGridPostExGroupKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGridPostExGroupCellClick(Column: TColumn);
    //角色删除权限组
    procedure SpeedButton4Click(Sender: TObject);
    procedure DBGridPostIncGroupDblClick(Sender: TObject);
    procedure DBGridPostIncGroupKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGridPostIncGroupCellClick(Column: TColumn);
    //权限组添加权限
    procedure SpeedButton5Click(Sender: TObject);
    procedure DBGridGroupExPurDblClick(Sender: TObject);
    procedure DBGridGroupExPurKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGridGroupExPurCellClick(Column: TColumn);
    //权限组删除权限
    procedure SpeedButton6Click(Sender: TObject);
    procedure DBGridGroupIncPurDblClick(Sender: TObject);
    procedure DBGridGroupIncPurKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGridGroupIncPurCellClick(Column: TColumn);
    //新建用户
    procedure BtnNewUserClick(Sender: TObject);
    //新建角色
    procedure BtnNewPostClick(Sender: TObject);
    //新建权限组
    procedure BtnNewGroupClick(Sender: TObject);
    //修改用户
    procedure DBGridUserDblClick(Sender: TObject);
    //修改角色
    procedure DBGridPostDblClick(Sender: TObject);
    //修改权限组
    procedure DBGridGroupDblClick(Sender: TObject);
    //删除用户
    procedure BtnDelUserClick(Sender: TObject);
    //删除角色
    procedure BtnDelPostClick(Sender: TObject);
    //删除权限组
    procedure BtnDelGroupClick(Sender: TObject);
    //PageContrl的刷新事件
    procedure PageCtrlPurDrawTab(Control: TCustomTabControl;
      TabIndex: Integer; const Rect: TRect; Active: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure DSLocalPostDataChange(Sender: TObject; Field: TField);
    procedure DSLocalUserDataChange(Sender: TObject; Field: TField);
    procedure SpeedButton7Click(Sender: TObject);
  private
    { Private declarations }
  protected
    { Protected declarations }

  public
    { Public declarations }
    //初始化标题
//    procedure InitTitle(Caption1, Caption2: string);
    //初始化DBGrid
    procedure InitDBGrid;

    //新建权限组
    procedure AddNewGroup;
    //修改权限组
    procedure UpdateGroup;
    //删除ID为Groupi的权限组
    procedure DelGroup(Groupi:integer);
    //读取权限组信息
    procedure ReadGroupInfo;
    //显示权限组包含的权限
    procedure ShowGroupIncPur;
    //显示权限组不包含的权限
    procedure ShowGroupExPur;
    //权限组添加权限
    procedure GroupAddPur;
    //权限组删除权限
    procedure GroupDelPur;
    //根据权限字符Pur读出相应的权限列表到数据集ADODS中
    procedure ReadPurInStr(var ADODS:TADODataSet;PurStr:string);
    //根据权限字符Pur读出相应的不包含权限列表到数据集ADODS中
    procedure ReadPurExStr(var ADODS:TADODataSet;PurStr:string);

    //权限字符串对应的权限(菜单)ID集
    procedure MenuIDs(PurStr: string; var IncIDs: array of Integer);
    //加一个菜单项到权限字符中
    procedure AddPur(var PurStr: string; MenuID: Integer);
    //减一个菜单项到权限字符中
    procedure DeductPur(var PurStr: string; MenuID: Integer);

    //新建角色
    procedure AddNewPost;
    //修改角色
    procedure UpdatePost;
    //删除角色
    procedure DelPost;
    //读取角色信息
    procedure ReadPostInfo;
    //显示角色包含的权限组
    procedure ShowPostIncGroup;
    //显示角色不包含的权限组
    procedure ShowPostExGroup;
    //显示角色包含的权限
    procedure ShowPostIncPur;
    //角色添加权限组
    procedure PostAddGroup;
    //角色删除权限组
    procedure PostDelGroup;
    //根据角色ID读出相应的权限组列表到数据集ADODS中
    procedure ReadGroupInPost(var ADODS:TADODataSet;PostID:integer);
    //根据角色ID读出相应的不包含权限组列表到数据集ADODS中
    procedure ReadGroupExPost(var ADODS:TADODataSet;PostID:integer);

     //新建用户
    procedure AddNewUser;
     //修改用户
    procedure UpdateUser;
    //删除用户
    procedure DelUser;
    //读取用户信息
    procedure ReadUserInfo;
    //显示用户包含的角色
    procedure ShowUserIncPost;
    //显示用户不包含的角色
    procedure ShowUserExPost;
    //显示用户包含的权限
    procedure ShowUserIncPur;
    //用户添加角色
    procedure UserAddPost;
    //用户删除角色
    procedure UserDelPost;

  //public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses math, PurNewGroup, PurNewPost,PurNewUser, PublicModel, DataModule;

{$R *.DFM}

{ TFrmNNewPur }

procedure TFrmMain.FormShow(Sender: TObject);
begin
  inherited;
  try
    PageCtrlPur.ActivePage := TabSheetUser;
    //初始化标题
//    InitTitle('用户权限设置窗口', '用户权限设置');
    //初始化DBGrid
    InitDBGrid;
    //读取用户信息
    ReadUserInfo;
    //读取岗位信息
    ReadPostInfo;
    //读取权限组信息
    ReadGroupInfo;
    //在状态栏中显示用户登录名
   { ShowLogonNameInStatusbar;
    //在状态栏中显示用户登录日期
    ShowDateInStatusbar;}
  finally
  end;
end;

//显示窗口标题
{procedure TFrmMain.InitTitle(Caption1, Caption2: string);
begin
  Caption := Application.Title + '-' + Caption1;
end;}

//设定所有的dbgrid列绑定的字段
procedure TFrmMain.InitDBGrid;
begin
  //用户管理
  DBGridUser.Columns.Items[0].FieldName := 'Per_Name';
  DBGridUser.Columns.Items[1].FieldName := 'Per_dlmz';
  DBGridUser.Columns.Items[2].FieldName := 'Per_mzms';

  DBGridUserIncPost.Columns.Items[0].FieldName := 'js_mc';
  DBGridUserIncPost.Columns.Items[1].FieldName := 'js_ms';

  DBGridUserExPost.Columns.Items[0].FieldName := 'js_mc';
  DBGridUserExPost.Columns.Items[1].FieldName := 'js_ms';

  DBGridUserIncPur.Columns.Items[0].FieldName := 'gn_mc';
  DBGridUserIncPur.Columns.Items[1].FieldName := 'gn_ms';

  //岗位管理
  DBGridPost.Columns.Items[0].FieldName := 'js_mc';
  DBGridPost.Columns.Items[1].FieldName := 'js_ms';

  DBGridPostIncGroup.Columns.Items[0].FieldName := 'gnz_mc';
  DBGridPostIncGroup.Columns.Items[1].FieldName := 'gnz_ms';

  DBGridPostExGroup.Columns.Items[0].FieldName := 'gnz_mc';
  DBGridPostExGroup.Columns.Items[1].FieldName := 'gnz_ms';

  DBGridPostIncPur.Columns.Items[0].FieldName := 'gn_mc';
  DBGridPostIncPur.Columns.Items[1].FieldName := 'gn_ms';

  //权限组管理
  DBGridGroup.Columns.Items[0].FieldName := 'gnz_mc';
  DBGridGroup.Columns.Items[1].FieldName := 'gnz_ms';

  DBGridGroupIncPur.Columns.Items[0].FieldName := 'gn_mc';
  DBGridGroupIncPur.Columns.Items[1].FieldName := 'gn_ms';

  DBGridGroupExPur.Columns.Items[0].FieldName := 'gn_mc';
  DBGridGroupExPur.Columns.Items[1].FieldName := 'gn_ms';  
end;

//新建一个功能组
procedure TFrmMain.AddNewGroup;
begin
  try
    //创建并显示新建功能组窗体
    FrmDPurNewGroup := TFrmDPurNewGroup.Create(nil);
    FrmDPurNewGroup.TypeOfNewGroup := tngNew ;
    FrmDPurNewGroup.GroupMc := '';
    FrmDPurNewGroup.GroupMs := '';
    if FrmDPurNewGroup.ShowModal = mrOK then  //用户选择确定
    begin
      ReadGroupInfo;
      DM.DSetGroup.Last;
    end;
  finally
    FrmDPurNewGroup.Free;
  end;
end;

//更新功能组信息,更改功能组的名称和描述
procedure TFrmMain.UpdateGroup;
var
  RecNo :integer;
begin
  try
    //创建并显示新建功能组窗体
    FrmDPurNewGroup := TFrmDPurNewGroup.Create(nil);
    FrmDPurNewGroup.TypeOfNewGroup := tngModify  ;
    FrmDPurNewGroup.GroupID := DM.DSetGroup.FieldByName('gnz_i').AsInteger ;
    FrmDPurNewGroup.GroupMc := DM.DSetGroup.FieldByName('gnz_mc').AsString;
    FrmDPurNewGroup.GroupMs :=  DM.DSetGroup.FieldByName('gnz_ms').AsString;
    if FrmDPurNewGroup.ShowModal = mrOK then  //用户选择确定
    begin
      RecNo := DM.DSetGroup.RecNo;
      ReadGroupInfo;
      DM.DSetGroup.RecNo := RecNo;
    end;
  finally
    FrmDPurNewGroup.Free;
  end;
end;

//删除ID为Groupi的功能组
procedure TFrmMain.DelGroup(Groupi:integer);
var
  sSQL: string;
  ArrayOfSQL:TStrings ;
  RecNo :integer;
begin
  ArrayOfSQL := nil;
  if DM.DSetGroup.RecordCount > 0 then //功能组表中存在功能组
  begin
    if showConfirmDlg('删除权限组吗?') then  //用户确认删除
    begin
      RecNo := DM.DSetGroup.RecNo;
      try
        ArrayOfSQL := TStringList.Create ;
        //删除权限组
        sSQL := 'delete from PMgnz where gnz_i = ' + IntToStr(Groupi);
        ArrayOfSQL.Add(sSQL);
        //删除“岗位与权限组关系表”中的权限组
        sSQL := 'delete from PMjsgn where jsgn_gni = ' + IntToStr(Groupi);
        ArrayOfSQL.Add(sSQL);
        try
          BatchSQL (ArrayOfSQL); //对删除进行批处理
        except
          showErrMsg('数据库读写错误!');
        end;
        ReadGroupInfo;
        if not DM.DSetGroup.IsEmpty then
        begin
          if RecNo > DM.DSetGroup.RecordCount then
            RecNo := DM.DSetGroup.RecordCount;
          DM.DSetGroup.RecNo := RecNo;
        end;
        ShowGroupIncPur ;
        ShowGroupExPur ;
        ShowPostIncGroup;
        ShowPostExGroup;
        ShowPostIncPur ;
        ShowUserIncPur ;
      finally
        ArrayOfSQL.Free ;
      end;
    end;
  end;
end;

//从数据库中读取所有的功能组信息
procedure TFrmMain.ReadGroupInfo;
var
  SQLStr: string;
begin
  try
    SQLStr :=  'select * from PMgnz order by gnz_i';
    ExecQuery(DM.DSetGroup, SQLStr );
  except
    showErrMsg('数据库读写错误!');
  end;
end;

//显示输出功能组包含的功能
procedure TFrmMain.ShowGroupIncPur;
begin
  if DM.DSetGroup.Active and (DM.DSetGroup.RecordCount > 0) then
  begin
    ReadPurInStr(DM.DSetGroupIncPur,
      DM.DSetGroup.FieldByName('gnz_gn').AsString) ;
  end
  else
  begin
    DM.DSetGroupIncPur.Active := False ;
  end;
end;

//显示输出功能组不包含的功能
procedure TFrmMain.ShowGroupExPur;
begin
  if DM.DSetGroup.Active and (DM.DSetGroup.RecordCount > 0) then
  begin
    ReadPurExStr(DM.DSetGroupExPur ,
      DM.DSetGroup.FieldByName('gnz_gn').AsString) ;
  end
  else
  begin
    DM.DSetGroupExPur.Active := False ;
  end;;
end;

//功能组中增加功能
procedure TFrmMain.GroupAddPur;
var
  PurStr: string;
  i,RecNo: Integer;
begin
  RecNo := DM.DSetGroupExPur.RecNo ;
  PurStr := DM.DSetGroup.FieldByName('gnz_gn').AsString;  //读出功能字符串
  {循环读入并向权限字符串中加入用户选择加入的功能}
  for i := 0 to DBGridGroupExPur.SelectedRows.Count - 1 do
  begin
    DBGridGroupExPur.DataSource.DataSet.
      GotoBookmark(pointer(DBGridGroupExPur.SelectedRows.Items[i]));
    {向功能字符串中加入选中的功能}
    AddPur(PurStr, DM.DSetGroupExPur.FieldByName('gn_i').AsInteger);
  end;
  DM.DSetGroup.Edit;
  DM.DSetGroup.FieldByName('gnz_gn').AsString := PurStr;
  DM.DSetGroup.Post;
  ShowPostIncGroup ;
  ShowPostIncPur ;
  ShowUserIncPur ;
  if RecNo > DM.DSetGroupExPur.RecordCount  then dec(recNo);
  if  not DM.DSetGroupExPur.IsEmpty then
    DM.DSetGroupExPur.RecNo := RecNo ;
end;

//功能组中删除功能
procedure TFrmMain.GroupDelPur;
var
  PurStr: string;
  i,RecNo: Integer;
begin
  RecNo := DM.DSetGroupIncPur.RecNo ;
  PurStr := DM.DSetGroup.FieldByName('gnz_gn').AsString;//读出功能字符串
  {循环读入并从权限字符串中减去用户选择删除的功能}
  for i := 0 to DBGridGroupIncPur.SelectedRows.Count - 1 do
  begin
    DBGridGroupIncPur.DataSource.DataSet.
      GotoBookmark(pointer(DBGridGroupIncPur.SelectedRows.Items[i]));
    {从功能字符串中删除选中的功能}
    DeductPur(PurStr, DM.DSetGroupIncPur.FieldByName('gn_i').AsInteger);
  end;
  DM.DSetGroup.Edit;
  DM.DSetGroup.FieldByName('gnz_gn').AsString := PurStr;
  DM.DSetGroup.Post ;
  ShowPostIncGroup ;
  ShowPostIncPur ;
  ShowUserIncPur ;
  if RecNo > DM.DSetGroupIncPur.RecordCount  then dec(recNo);
  if  not DM.DSetGroupIncPur.IsEmpty then
    DM.DSetGroupIncPur.RecNo := RecNo ;
end;

//根据权限字符Pur读出相应的权限列表到数据集ADODS中
procedure TFrmMain.ReadPurInStr(var ADODS:TADODataSet;PurStr:string);
var
  IncIDs: array of Integer;
  SQLStr: string;
  i: Integer;
begin
  SetLength(IncIDs,length(PurStr) * 6 );
  MenuIDs(PurStr , IncIDs); //将Purstr指定的功能转化到整型数组中
  //以下根据整型数组生成字符串
  SQLStr := 'select gn_i,gn_mc,gn_ms from PMgsgn where  (gn_i = -1';
  for i := 1 to length(IncIDs) - 1 do
  begin
    if IncIDs[i] > 0 then
    begin
      SQLStr := SQLStr + ' or gn_i = ' + IntToStr(i);
    end;
  end;
  SQLStr := SQLStr + ')';
  try
    ExecQuery(ADODS, SQLStr);
  except

⌨️ 快捷键说明

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