📄 frm_right.pas
字号:
{
***************************************************************
* 说明：权限管理 *
* 时间：2003/02/20 *
* 作者：杨泉清 *
***************************************************************
}
unit frm_Right;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ModalForm, ComCtrls, Menus, StdCtrls, ExtCtrls, YLabelButton,
ChangeImage, Buttons, ADODB, DB, ImgList;
type
TRightSet = class(TMyModalForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
Image1: TImage;
Label4: TLabel;
Label5: TLabel;
Label1: TLabel;
Lv_User: TListView;
ChangeImg1: TChangeImg;
LabelB1: TLabelB;
ChangeImg2: TChangeImg;
LabelB3: TLabelB;
ChangeImg3: TChangeImg;
LabelB4: TLabelB;
Tv_Group: TTreeView;
Label2: TLabel;
GroupBox2: TGroupBox;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
ChangeImg4: TChangeImg;
LabelB2: TLabelB;
ChangeImg5: TChangeImg;
LabelB5: TLabelB;
ChangeImg14: TChangeImg;
LabelB15: TLabelB;
Label3: TLabel;
Label11: TLabel;
GroupBox5: TGroupBox;
Label12: TLabel;
Label13: TLabel;
GroupBox1: TGroupBox;
GroupBox3: TGroupBox;
LbGroup: TListBox;
Tv_Right: TTreeView;
Label14: TLabel;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
PopupMenu2: TPopupMenu;
N3: TMenuItem;
N4: TMenuItem;
N6: TMenuItem;
N5: TMenuItem;
N18: TMenuItem;
ImageList1: TImageList;
PopupMenu3: TPopupMenu;
N7: TMenuItem;
N8: TMenuItem;
ADOUser: TADOTable;
ADODelUser: TADOStoredProc;
ADODelGroup: TADOStoredProc;
procedure ChangeImg1Click(Sender: TObject);
procedure ChangeImg3Click(Sender: TObject);
procedure ChangeImg2Click(Sender: TObject);
procedure Lv_UserDblClick(Sender: TObject);
procedure ChangeImg4Click(Sender: TObject);
procedure TabSheet2Show(Sender: TObject);
procedure TabSheet1Show(Sender: TObject);
procedure ChangeImg5Click(Sender: TObject);
procedure ChangeImg14Click(Sender: TObject);
procedure TabSheet3Show(Sender: TObject);
procedure Tv_RightClick(Sender: TObject);
procedure Tv_RightDblClick(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure LbGroupClick(Sender: TObject);
private
{ Private declarations }
procedure ShowUserList;
procedure ShowGroup;
procedure AddUsr(tvname: TtreeView; GroupName: string; UsrName: string);
procedure Change_Right(tvnode: Ttreenode; ImageIndex: integer); //改变权限
procedure GetRight(Name: string; bz: string);
public
{ Public declarations }
end;
var
RightSet: TRightSet;
implementation
Uses
Uglobal,DM_DataModal,Frm_AddUser,Frm_AddGroup,UGeneralFunc
,Frm_UserInfo,Frm_AddUserToGroup;
{$R *.dfm}
procedure TRightset.ShowUserList;
var
ListItem:TListItem;
begin
inherited;
lv_user.Clear ;
if AdoUser.Active then
AdoUser.Active :=false;
AdoUser.Active :=true;
if AdoUser.RecordCount <1 then exit;
AdoUser.First ;
While not AdoUser.Eof do
begin
ListItem:=lv_user.Items.Add ;
ListItem.Caption :=AdoUser.FieldByName('usrname').Value;
ListItem.SubItems.Add(AdoUser.FieldByName('GroupName').Value);
AdoUser.Next ;
end;
end;
procedure TRightSet.ShowGroup;
var
TreeNodeTmp: TtreeNode;
TempQry:TAdoQuery;
begin
inherited;
TempQry:=TAdoQuery.Create(nil);
TempQry.Connection :=WindData.AdoConn ;
TV_Group.Items.Clear;
TV_Group.Items.AddChild(nil, '组用户');
TV_Group.Items[0].ImageIndex := 3;
TV_Group.Items[0].SelectedIndex := 3;
with TempQry do
begin
sql.Clear;
sql.Add('select * from Usr_GroupInfo');
open;
end;
while not TempQry.Eof do
begin
TreeNodeTmp := TV_Group.Items.AddChild(TV_Group.Items[0], TempQry.fieldbyname('GroupName').value);
//TreeNodeTmp := TV_Group.Items.AddChild(nil, TempQry.fieldbyname('GroupName').value);
TreeNodeTmp.ImageIndex := 3;
TreeNodeTmp.SelectedIndex := 3;
TempQry.Next;
end;
with TempQry do
begin
sql.Clear;
sql.Add('select * from Usr_Info');
open;
end;
while not TempQry.Eof do
begin
if (length(TempQry.FieldByName('GroupName').Value) > 0) then
AddUsr(tv_Group, TempQry.fieldbyname('GroupName').value, TempQry.fieldbyname('UsrName').value);
TempQry.Next;
end;
end;
procedure TRightSet.AddUsr(tvname: TtreeView; GroupName: string; UsrName: string);
var
tmp: Ttreenode;
tvnode_parent: tTreeNode;
i: integer;
begin
try
tvnode_parent := tvname.Items[0];
except
exit;
end;
for i := 0 to tvnode_parent.Count - 1 do
begin
if tvnode_parent.Item[i].Text = GroupName then
begin
tvnode_parent := tvnode_parent.Item[i];
tmp := tvname.Items.AddChild(tvnode_parent, UsrName);
tmp.ImageIndex := 4;
tmp.SelectedIndex := 4;
break;
end;
end;
end;
procedure TRightSet.ChangeImg1Click(Sender: TObject);
begin
inherited;
GsUserName:='';
AddUser:=TAddUser.Create(Application);
if AddUser.ShowModal <>2 then
ShowUserList;
end;
procedure TRightSet.ChangeImg3Click(Sender: TObject);
var
msg:string;
ListItem:TListItem;
begin
inherited;
if lv_user.SelCount<1 then exit;
msg:= '请确认要删除该用户' ;
if showmsg(msg,0,2) then;
begin
ListItem:=Lv_user.Selected ;
With ADODelUser do
begin
parameters.ParamByName('@optmode').Value :=2;
parameters.ParamByName('@UsrName').Value :=ListItem.Caption ;
Try
Execproc;
Except
msg:='删除用户失败！';
showmsg(msg,1,2);
end;
ListItem.Delete ;
end;
end;
end;
procedure TRightSet.ChangeImg2Click(Sender: TObject);
begin
inherited;
if not assigned(UserInfo) then
UserInfo:=TUserInfo.Create(Application);
UserInfo.Show ;
end;
procedure TRightSet.Lv_UserDblClick(Sender: TObject);
var
ListItem:TListItem;
begin
inherited;
GsUserName:='';
if Lv_user.SelCount <1 then exit;
ListItem:=Lv_user.Selected ;
GsUserName:=ListItem.Caption ;
AddUser:=TAddUser.Create(Application);
if AddUser.ShowModal <>2 then
ShowUserList ;
end;
procedure TRightSet.ChangeImg4Click(Sender: TObject);
begin
inherited;
AddGroup:=TAddGroup.Create(Application);
if AddGroup.ShowModal <>2 then
ShowGroup;
end;
procedure TRightSet.TabSheet2Show(Sender: TObject);
begin
inherited;
ShowGroup;
end;
procedure TRightSet.TabSheet1Show(Sender: TObject);
begin
inherited;
ShowUserList;
end;
procedure TRightSet.ChangeImg5Click(Sender: TObject);
var
msg:string;
TempQry:TAdoQuery;
begin
inherited;
TempQry:=TAdoQuery.Create(nil);
TempQry.Connection :=WindData.AdoConn ;
if Tv_group.Selected.Text ='' then exit;
msg:='请确认要删除该组！';
if showmsg(msg,0,2) then
begin
With TempQry do
begin
sql.Clear ;
sql.Add('select * from Usr_info where GroupName like '''+Tv_group.Selected.Text+'''') ;
open;
end;
if TempQry.RecordCount >0 then
begin
msg:='请先删除该组下的成员！';
showmsg(msg,1,0);
end;
with AdoDelGroup do
begin
parameters.ParamByName('@optmode').Value :=2;
parameters.ParamByName('@GroupName').Value :=Tv_group.Selected.Text ;
try
Execproc;
Except
msg:='删除组操作失败！';
showmsg(msg,1,2);
end;
ShowGroup;
end;
end;
end;
procedure TRightSet.ChangeImg14Click(Sender: TObject);
begin
inherited;
AddUserToGroup:=TAddUserToGroup.Create(Application);
if AddUserToGroup.ShowModal <> 2 then
ShowGroup;
end;
procedure TRightSet.TabSheet3Show(Sender: TObject);
var
TempQry:TAdoQuery;
begin
inherited;
TempQry:=TAdoQuery.Create(nil);
TempQry.Connection :=WindData.AdoConn ;
with TempQry do
begin
sql.Clear ;
sql.Add('select * from Usr_GroupInfo');
open;
end;
lbgroup.Clear ;
while not TempQry.Eof do
begin
lbgroup.Items.Add(TempQry.FieldbyName('Name').value);
TempQry.Next ;
end;
if Lbgroup.ItemIndex<0 then exit;
lbgroup.ItemIndex :=0;
GetRight(Lbgroup.Items.Strings[Lbgroup.ItemIndex], '组');
end;
procedure TRightSet.GetRight(Name: string; bz: string);
var
Num: integer; //每级菜单的位数
TvNodeTmp: Ttreenode;
str_RightNum: string; //权限号
i, j: integer;
str_sql: string;
TempQry,GroupQry:TAdoQuery;
begin
num:=2;
TempQry:=TAdoQuery.Create(nil);
TempQry.Connection :=WindData.AdoConn ;
GroupQry:=TAdoQuery.Create(nil);
GroupQry.Connection :=WindData.AdoConn ;
with TempQry do
begin
sql.Clear ;
sql.Add('select * from Usr_rightinfo order by RightNum');
open;
end;
tv_right.Items.Clear;
tv_right.Items.AddChild(nil, '权限');
tv_right.Items[0].ImageIndex := 3;
tv_right.Items[0].SelectedIndex := 3;
while not TempQry.Eof do
begin
str_RightNum := trim(TempQry.fieldbyname('RightNum').value);
TvNodeTmp := tv_right.Items[0];
for i := 0 to ((length(str_rightNum) div Num) - 2) do
begin
j := strtoint(copy(str_rightNum, i * 2 + 1, 2));
TvNodeTmp := TvNodeTmp.Item[j - 1];
end;
TvNodeTmp := tv_Right.Items.AddChild(TvNodeTmp, TempQry.fieldbyname('RightMemo').value);
str_sql := 'select * from Usr_Right where GroupName=''' + Name + '''';
str_sql := str_sql + ' and RightNum=''' + str_RightNum + '''';
with groupqry do
begin
sql.Clear ;
sql.Add(str_sql);
open;
end;
if groupqry.RecordCount = 0 then
begin
TvNodeTmp.ImageIndex := 1;
TvNodeTmp.SelectedIndex := 1;
end
else begin
TvNodeTmp.ImageIndex := 0;
TvNodeTmp.SelectedIndex := 0;
end;
TempQry.Next;
end;
end;
procedure TRightSet.change_Right(tvnode: Ttreenode; ImageIndex: integer); //改变权限
var //imageindex为0表示赋予权限，为1表示拒绝权限
i: integer;
StrTmp: string;
Str: string;
str_sql: string;
TTreeNodeTmp: ttreenode;
TempQry:TAdoQuery;
begin
TempQry :=TAdoQuery.Create(nil);
TempQry.Connection :=WindData.AdoConn ;
TvNode.ImageIndex := ImageIndex;
TvNode.SelectedIndex := ImageIndex;
str := ''; //的到权限号
TTreeNodeTmp := tvnode;
while TTreeNodeTmp.Parent <> nil do
begin
StrTmp := inttostr(TTreeNodeTmp.index + 1);
if length(strTmp) = 1 then strtmp := '0' + strtmp;
str := strtmp + str;
TTreeNodeTmp := TTreeNodeTmp.Parent;
end;
if imageindex = 0 then //赋予权限
begin
str_sql := 'insert into Usr_right(GroupName,RightNum,bz) values(''';
str_sql := str_sql + Lbgroup.Items.Strings[Lbgroup.ItemIndex] + ''',''';
str_sql := str_sql + str + ''',';
str_sql := str_sql + '''组'')';
with TempQry do
begin
sql.Clear ;
sql.Add(str_sql);
ExecSql;
end;
end
else if imageindex = 1 then //拒绝权限
begin
str_sql := 'delete from Usr_right where GroupName=''';
str_sql := str_sql + Lbgroup.Items.Strings[Lbgroup.ItemIndex] + ''' and bz=''';
str_sql := str_sql + '组''';
str_sql := str_sql + ' and RightNum=''' + str + '''';
with TempQry do
begin
try
sql.Clear ;
sql.add(str_sql);
ExecSQL;
except
end;
end;
end;
for i := 0 to tvnode.Count - 1 do change_Right(tvnode.Item[i], imageIndex); //子节点
end;
procedure TRightSet.Tv_rightClick(Sender: TObject);
begin
inherited;
if tv_right.Items.Count = 0 then exit;
if tv_right.Selected.ImageIndex = 0 then //赋予权限变灰
begin
n7.Enabled := false;
n8.Enabled := true;
end
else
if tv_right.Selected.ImageIndex = 1 then //赋予权限变灰
begin
n7.Enabled := true;
n8.Enabled := false;
end
else
begin
n7.Enabled := false;
n8.Enabled := false;
end;
end;
procedure TRightSet.Tv_RightDblClick(Sender: TObject);
var
msg:string;
begin
inherited;
if tv_right.Items.Count = 0 then exit;
msg:= '请确认是否改变权限！' ;
if not showmsg(msg,0,1) then exit;
if tv_right.Selected.ImageIndex = 0 then
change_Right(tv_right.Selected, 1)
else
if tv_right.Selected.ImageIndex = 1 then
change_Right(tv_right.Selected, 0);
if tv_right.Selected.ImageIndex = 0 then //赋予权限变灰
begin
n7.Enabled := false;
n8.Enabled := true;
end
else
if tv_right.Selected.ImageIndex = 1 then //赋予权限变灰
begin
n7.Enabled := true;
n8.Enabled := false;
end
else
begin
n7.Enabled := false;
n8.Enabled := false;
end;
end;
procedure TRightSet.N7Click(Sender: TObject);
begin
inherited;
Tv_RightDblClick(Sender);
end;
procedure TRightSet.N8Click(Sender: TObject);
begin
inherited;
Tv_RightDblClick(Sender);
end;
procedure TRightSet.N1Click(Sender: TObject);
begin
inherited;
ChangeImg1Click(Sender);
end;
procedure TRightSet.N2Click(Sender: TObject);
begin
inherited;
ChangeImg3Click(Sender);
end;
procedure TRightSet.N15Click(Sender: TObject);
begin
inherited;
ChangeImg2Click(Sender);
end;
procedure TRightSet.N3Click(Sender: TObject);
begin
inherited;
ChangeImg4Click(Sender);
end;
procedure TRightSet.N4Click(Sender: TObject);
begin
inherited;
ChangeImg5Click(Sender);
end;
procedure TRightSet.N5Click(Sender: TObject);
begin
inherited;
ChangeImg14Click(Sender);
end;
procedure TRightSet.LbGroupClick(Sender: TObject);
begin
inherited;
GetRight(Lbgroup.Items.Strings[Lbgroup.ItemIndex], '组');
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -