📄 main.pas
字号:
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 + -