?? 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 + -