📄 frmpurveset.frm
字号:
VERSION 5.00
Begin VB.Form frmPurveSet
BorderStyle = 1 'Fixed Single
Caption = "对用户使用模块的权限进行设置"
ClientHeight = 3930
ClientLeft = 1050
ClientTop = 1530
ClientWidth = 6225
Icon = "frmPurveSet.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3930
ScaleWidth = 6225
StartUpPosition = 2 '屏幕中心
Begin VB.ComboBox ComboUser
BackColor = &H00FFFFFF&
Height = 300
ItemData = "frmPurveSet.frx":0442
Left = 4485
List = "frmPurveSet.frx":0444
TabIndex = 14
Top = 210
Width = 1365
End
Begin VB.ComboBox ComboDep
BackColor = &H00FFFFFF&
Height = 300
ItemData = "frmPurveSet.frx":0446
Left = 1635
List = "frmPurveSet.frx":0448
TabIndex = 12
Top = 210
Width = 1365
End
Begin VB.CommandButton CmdClose
Caption = "取消"
Default = -1 'True
Height = 310
Left = 3355
TabIndex = 2
Top = 3420
Width = 1000
End
Begin VB.CommandButton CmdPurvSet
Caption = "设置"
Height = 310
Left = 1870
TabIndex = 1
Top = 3420
Width = 1000
End
Begin VB.Frame Frame1
Caption = "权限"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 2415
Left = 210
TabIndex = 0
Top = 780
Width = 5805
Begin VB.CheckBox checkqx
Caption = "标签管理"
Height = 210
Index = 1
Left = 330
TabIndex = 18
Top = 1410
Width = 1215
End
Begin VB.CheckBox checkqx
Caption = "PN表管理"
Height = 210
Index = 0
Left = 330
TabIndex = 17
Top = 1020
Width = 1215
End
Begin VB.CheckBox checkqx
Caption = "安标管理"
Height = 210
Index = 4
Left = 330
TabIndex = 16
Top = 630
Width = 1215
End
Begin VB.CheckBox checkqx
Caption = "定时备份"
Height = 210
Index = 11
Left = 4170
TabIndex = 11
Top = 1020
Width = 1215
End
Begin VB.CheckBox checkqx
Caption = "手工备份"
Height = 210
Index = 6
Left = 4170
TabIndex = 10
Top = 1410
Width = 1215
End
Begin VB.CheckBox checkqx
Caption = "数据恢复"
Height = 210
Index = 2
Left = 4170
TabIndex = 9
Top = 1800
Width = 1215
End
Begin VB.CheckBox checkqx
Caption = "系统日志"
Height = 210
Index = 3
Left = 2220
TabIndex = 8
Top = 1800
Width = 1395
End
Begin VB.CheckBox checkqx
Caption = "重新登录"
Height = 210
Index = 10
Left = 4170
TabIndex = 7
Top = 630
Width = 1215
End
Begin VB.CheckBox checkqx
Caption = "人员设置"
Height = 210
Index = 7
Left = 2220
TabIndex = 6
Top = 630
Width = 1395
End
Begin VB.CheckBox checkqx
Caption = "权限设置"
Height = 210
Index = 8
Left = 2220
TabIndex = 5
Top = 1020
Width = 1395
End
Begin VB.CheckBox checkqx
Caption = "密码更改"
Height = 210
Index = 9
Left = 2220
TabIndex = 4
Top = 1410
Width = 1395
End
Begin VB.CheckBox checkqx
Caption = "退出系统"
Height = 210
Index = 5
Left = 330
TabIndex = 3
Top = 1800
Width = 1215
End
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择用户："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Left = 3225
TabIndex = 15
Top = 240
Width = 1260
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择部门："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Left = 375
TabIndex = 13
Top = 240
Width = 1260
End
Begin VB.Line Line1
BorderColor = &H00808000&
BorderWidth = 2
X1 = 150
X2 = 6050
Y1 = 660
Y2 = 660
End
End
Attribute VB_Name = "frmPurveSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsTemp As ADODB.Recordset
Dim PurvString As String '存放权限值
Dim i As Integer '
Private Sub CmdPurvSet_Click()
Dim vntTemp As Variant
PurvString = ""
For i = 0 To moduledex '遍历模块权限
If checkqx(i) = 1 Then
PurvString = PurvString + "1"
Else
PurvString = PurvString + "0"
End If
Next i
rsTemp.Close
rsTemp.Open "Select * From 用户权限", cnSys
rsTemp.Find "用户帐号='" & Trim(ComboUser.Text) & "'"
rsTemp("使用模块") = PurvString
rsTemp.Update
MsgBox "用户权限设置完成！", 0 + 64, "设置权限"
End Sub
Private Sub CmdClose_Click()
rsTemp.Close
Set rsTemp = Nothing
Unload Me
End Sub
Private Sub ComboDep_Click()
'根据选择的部门列出人员名称
Dim vntTemp As Variant
rsTemp.Close
rsTemp.Open "Select Distinct 用户帐号 From 用户权限 Where 部门='" & Trim(ComboDep.Text) & "'", cnSys
ComboUser.Clear
Do While Not rsTemp.EOF
vntTemp = rsTemp("用户帐号")
If IsNull(vntTemp) Then vntTemp = ""
ComboUser.AddItem CStr(vntTemp)
rsTemp.MoveNext
Loop
End Sub
Private Sub ComboUser_Click()
'显示用户的权限情况
rsTemp.Close
rsTemp.Open "Select * From 用户权限", cnSys
rsTemp.Find "用户帐号='" & ComboUser.Text & "'"
If IsNull(rsTemp("使用模块")) Then
PurvString = "000000000000"
Else
PurvString = Trim(rsTemp("使用模块"))
End If
For i = 0 To Len(PurvString) - 1
If Mid(PurvString, i + 1, 1) = "1" Then
checkqx(i).Value = 1
Else
checkqx(i).Value = 0
End If
Next i
End Sub
Private Sub Form_Load()
Dim vntTemp As Variant
'初始化列表框
Set rsTemp = New ADODB.Recordset '初始化数据库
rsTemp.CursorType = adOpenKeyset
rsTemp.LockType = adLockOptimistic
rsTemp.Open "Select Distinct 部门 From 用户权限", cnSys
Do While Not rsTemp.EOF
vntTemp = rsTemp("部门")
If IsNull(vntTemp) Then vntTemp = ""
ComboDep.AddItem CStr(vntTemp)
rsTemp.MoveNext
Loop
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -