📄 frmlim.frm
字号:
Width = 2295
End
Begin VB.CheckBox Check1
BackColor = &H00C0E0FF&
Caption = "Check1"
Height = 375
Index = 2
Left = 120
TabIndex = 9
Top = 840
Width = 2295
End
Begin VB.CheckBox Check1
BackColor = &H00C0E0FF&
Caption = "Check1"
Height = 375
Index = 13
Left = 2640
TabIndex = 8
Top = 2040
Width = 2295
End
Begin VB.CheckBox Check1
BackColor = &H00C0E0FF&
Caption = "Check1"
Height = 375
Index = 1
Left = 120
TabIndex = 7
Top = 240
Width = 2295
End
End
Begin VB.CommandButton Command4
BackColor = &H00FFC0C0&
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8640
Style = 1 'Graphical
TabIndex = 5
Top = 5760
Width = 975
End
Begin VB.CommandButton Command3
BackColor = &H00FFC0C0&
Caption = "全不选"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4440
Style = 1 'Graphical
TabIndex = 4
Top = 5760
Width = 1095
End
Begin VB.Frame Frame1
BackColor = &H00C0C0FF&
Caption = "用户角色"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 6015
Left = 120
TabIndex = 2
Top = 120
Width = 1575
Begin MSComctlLib.ListView LstVAd
Height = 5655
Left = 120
TabIndex = 3
Top = 240
Width = 1335
_ExtentX = 2355
_ExtentY = 9975
LabelWrap = -1 'True
HideSelection = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = 16711680
BackColor = 12640511
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
End
Begin VB.CommandButton Command2
BackColor = &H00FFC0C0&
Caption = "确定"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5760
Style = 1 'Graphical
TabIndex = 1
Top = 5760
Width = 1095
End
Begin VB.CommandButton Command1
BackColor = &H00FFC0C0&
Caption = "全选"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3120
Style = 1 'Graphical
TabIndex = 0
Top = 5760
Width = 1095
End
End
Attribute VB_Name = "frmlim"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************
'模块名称：权限管理模块
'模块功能：完成对用户的权限管理，包括赋予权限和取消权限
'版本 ：1.0版
'代码编写者：熊锋
'编写日期：2006-11-6
'*********************************************
Private Sub Command1_Click() '选择所有操作权限
Dim i As Integer '定义一个循环变量
For i = 1 To Check1.UBound
Check1(i).Value = 1
Next i
End Sub
Private Sub Command2_Click() '将操作权限信息存入数据库中,SelectedItem用于返回对所选 ListItem的引用
Dim rs As New ADODB.Recordset
rs.Open "select * from Limit_Info where Role_id in (select Role_id from Role_Info where Role_Name='" + LstVAd.SelectedItem + "')", DBCnn, adOpenStatic, adLockOptimistic
If rs.RecordCount <= 0 Then
MsgBox "请从左边列表中选择一个角色"
Else
For i = 1 To Check1.UBound 'Check1.UBound返回控件数组的最大下标
rs.Fields(i) = Check1(i).Value
Next i
rs.Update
MsgBox "对角色：" & LstVAd.SelectedItem & "的权限设置成功"
'完成事务日志的填写
rslog.Open "select * from Log_Info where 操作员=''", DBCnn, adOpenStatic, adLockOptimistic
rslog.AddNew
rslog.Fields("操作员") = frmlog.txtuser.Text
rslog.Fields("日期") = Date
rslog.Fields("操作时间") = Time
rslog.Fields("操作模块") = "权限管理界面"
rslog.Fields("操作") = "权限设置"
rslog.Fields("备注") = "设置了角色：" & LstVAd.SelectedItem & "的权限"
rslog.Update
rslog.Close
rs.Close
End If
End Sub
Private Sub Command3_Click() '所有操作权限全不选
Dim i As Integer '定义一个循环变量
For i = 1 To Check1.UBound
Check1(i).Value = 0
Next i
End Sub
Private Sub Command4_Click()
frmlim.Hide
End Sub
Private Sub Command5_Click()
Unload frmlim
frmlim.Show
End Sub
Private Sub Command6_Click()
Dim rs As New ADODB.Recordset
rs.Open "select * from Reg_Info", DBCnn, adOpenStatic, adLockOptimistic
rs.Fields("Reg") = Check2.Value
rs.Update
rs.Close
MsgBox "注册权设置成功"
rslog.Open "select * from Log_Info where 操作员=''", DBCnn, adOpenStatic, adLockOptimistic
rslog.AddNew
rslog.Fields("操作员") = frmlog.txtuser.Text
rslog.Fields("日期") = Date
rslog.Fields("操作时间") = Time
rslog.Fields("操作模块") = "权限管理界面"
rslog.Fields("操作") = "权限设置"
rslog.Fields("备注") = "设置了使用者注册权"
rslog.Update
rslog.Close
End Sub
Private Sub Form_Load() '初始化check1(i).caption的值并将已有用户加入到用户列表中
Dim rs As New ADODB.Recordset '定义记录集，用于打开权限信息表
Dim rs1 As New ADODB.Recordset '定义记录集，用于打开角色信息表
Dim rs2 As New ADODB.Recordset '定义记录集,用于打开注册权限表
Dim Mystr As String
Dim itmX As ListItem '声明一个ListItem对象
Dim i As Integer
'打开权限信息表，将表中各个列名给 Check1(i).Caption
rs.Open "select * from Limit_Info ", DBCnn, adOpenStatic, adLockOptimistic
For i = 1 To Check1.UBound
Check1(i).Caption = rs.Fields(i).Name '将Limit_Info表中的列名赋值给check1(i).caption
Next i
rs.Close
'打开用户表SysAd_Info，并将所有用户名添加到LstVAd中
Set itmX = LstVAd.ListItems.Add(, , " ")
rs1.Open "select Role_Name from Role_Info ", DBCnn, adOpenStatic, adLockOptimistic
rs1.Move First
Do While rs1.EOF = False
Mystr = rs1.Fields("Role_Name")
Set itmX = LstVAd.ListItems.Add(, , Mystr) '将一个对象添加到列表中
rs1.MoveNext
Loop
rs1.Close
rs2.Open "select * from Reg_Info ", DBCnn, adOpenStatic, adLockOptimistic
Check2.Value = rs2.Fields("Reg")
End Sub
Private Sub LstVAd_Click() '点击LstVAd中相应的用户名，在权限设置界面上显示该用户已有的操作权限
Dim rs3 As New ADODB.Recordset '定义一个记录集 ，记录一个用户的操作权限信息
'打开权限表Limit_Info，用户名为LstVAd中选择的用户
rs3.Open "select * from Limit_Info,Role_Info where Role_Name='" + LstVAd.SelectedItem + "' and Role_Info.Role_id=Limit_Info.Role_id", DBCnn, adOpenStatic, adLockOptimistic
If rs3.RecordCount > 0 Then
For i = 1 To Check1.UBound
If rs3.Fields(i) = "" Then
Check1(i).Value = 0 '用户不存在该权限时，相应选项没有打钩
Else
Check1(i).Value = rs3.Fields(i) '用户存在该权限时，相应选项打钩
End If
Next i
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -