📄 frmadmin.frm
字号:
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4560
TabIndex = 18
Top = 840
Width = 615
End
Begin VB.Label Label1
BackColor = &H00FFC0C0&
Caption = "用户名"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 1800
TabIndex = 15
Top = 240
Width = 855
End
Begin VB.Label Label2
BackColor = &H00FFC0C0&
Caption = "密码"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 4560
TabIndex = 14
Top = 240
Width = 615
End
Begin VB.Label Label3
BackColor = &H00FFC0C0&
Caption = "权限类型"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 1800
TabIndex = 13
Top = 960
Width = 855
End
Begin VB.Label Label4
BackColor = &H00FFC0C0&
Caption = "备注"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 1800
TabIndex = 12
Top = 1560
Width = 615
End
End
Attribute VB_Name = "frmadmin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo1_KeyPress(KeyAscii As Integer) '控制Combol，不让用户输入
KeyAscii = 0
End Sub
'************************************************
'模块名称：用户管理模块
'模块功能：完成用户信息的添加，修改用户密码，删除用户
'版本 ：1.0版
'代码编写者：熊锋
'编写日期 ：2006-10-22
'***********************************************
Private Sub Command1_Click() '单击添加用户按钮时，将界面上文本框置空，以便输入要添加的用户信息
TxtName.Locked = False '添加用户时将用户名文本框改为可编辑
TxtName.Text = ""
Txtsec.Locked = False
Combo1.Text = ""
RTxtBox1.Text = ""
MsgBox "请输入要添加的用户信息！"
End Sub
Private Sub Command2_Click() '删除一个已经存在的用户，并同时将权限表中的信息删除
Dim rs As New ADODB.Recordset '定义记录集，用于打开用户信息表
Dim rs1 As New ADODB.Recordset '定义记录集，用于打开权限信息表
'打开用户信息表
If TxtName.Text = "" Then
MsgBox "请从左侧用户列表中选择一个要删除的用户"
Exit Sub
End If
If TxtName.Text = "Admin" Then
MsgBox "不能删除超级用户：Admin"
Exit Sub
End If
'选择了一个用户后，将该用户信息从用户信息表中删除，并将权限信息一并删除
'打开用户信息表
If MsgBox("确实要删除记录吗？", vbYesNo + vbQuestion + vbDefaultButton1, "确认窗口") = vbYes Then
rs.Open "select * from SysAd_Info where Admin_Name='" + ListView1.SelectedItem + "'", DBCnn, adOpenStatic, adLockOptimistic
rs.Delete '删除用户信息表中用户信息
MsgBox "成功删除该用户！"
Unload frmadmin
frmadmin.Show
'完成事务日志的填写
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("备注") = "删除用户：" & TxtName.Text
rslog.Update
rslog.Close
rs.Close
End If
End Sub
Private Sub Command3_Click() '对用户进行锁定
Dim rs As New ADODB.Recordset
If TxtName.Text = "" Then
MsgBox "请选择一个要锁定的用户！"
Exit Sub
End If
If MsgBox("确实要锁定该用户吗？", vbYesNo + vbQuestion + vbDefaultButton1, "确认窗口") = vbYes Then
rs.Open "select * from SysAd_Info where Admin_Name='" & Trim(TxtName.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
rs.Fields("Times") = 1000 '用户锁定时，将其不正确登录次数设为100，该用户即被锁定
rs.Update
MsgBox "该用户已被锁定"
TxtZT.Text = "已锁定"
'完成事务日志的填写
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("备注") = "锁定用户：" & TxtName.Text
rslog.Update
rslog.Close
rs.Close
End If
End Sub
'添加用户时在权限表中同步添加用户信息
Private Sub Command4_Click() '添加一个新用户，并同时在用户权限表中添加该用户
Dim rs1 As New ADODB.Recordset '定义记录集，用于打开用户信息表，判断新添加的用户名是否与已有用户名相同
Dim rs2 As New ADODB.Recordset '定义记录集，用于打开用户信息表，并添加新的用户信息
Dim rs4 As New ADODB.Recordset
If TxtName.Text = "" Then
MsgBox "用户名不能为空，请填写用户名"
Exit Sub
End If
If Txtsec = "" Then
MsgBox "密码不能为空，请填写"
Exit Sub
End If
If Combo1.Text = "" Then
MsgBox "权限类型必须选择"
Exit Sub
End If
rs4.Open "select Role_id from Role_Info where Role_Name='" & Trim(Combo1.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
rs1.Open "select * from SysAd_Info where Admin_Name='" & Trim(TxtName.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
If rs1.RecordCount > 0 Then
MsgBox "存在用户名为：" & TxtName.Text & "的用户，不能添加！"
Exit Sub
End If
'打开权限信息表
rs2.Open "select * from SysAd_Info", DBCnn, adOpenStatic, adLockOptimistic
rs2.AddNew '将用户信息添加到用户信息表中
rs2.Fields("Admin_Name") = TxtName.Text
rs2.Fields("Admin_SecNum") = Txtsec.Text
rs2.Fields("Admin_Else") = RTxtBox1.Text
rs2.Fields("Role_id") = rs4.Fields("Role_id")
rs2.Update
rs2.Close
'完成事务日志的填写
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("备注") = "添加用户名：" & TxtName.Text
rslog.Update
rslog.Close
MsgBox "已成功添加该用户！"
Unload frmadmin
frmadmin.Show
TxtName.Text = "" '成功添加用户之后，将界面上文本框置空
Txtsec.Text = ""
Combo1.Text = "请选择"
RTxtBox1.Text = ""
ListView1.Refresh
End Sub
Private Sub Command5_Click() '当用户被锁定不能登录系统时，Admin可以对用户进行解锁
Dim rs As New ADODB.Recordset
If TxtName.Text = "" Then
MsgBox "请选择一个需要解除锁定的用户！"
Exit Sub
End If
rs.Open "select * from SysAd_Info where Admin_Name='" & Trim(TxtName.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
rs.Fields("Times") = 0
rs.Update
MsgBox "已完成对用户：" & TxtName.Text & "的解锁！"
TxtZT.Text = "已解锁"
'完成事务日志的填写
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("备注") = "解除锁定用户：" & TxtName.Text
rslog.Update
rslog.Close
rs.Close
End Sub
Private Sub Command6_Click() '刷新，用户信息改变时后刷新可以看到改变后的信息
Unload frmadmin
frmadmin.Show
End Sub
Private Sub Form_Load() '打开用户表并用记录集方式将已有用户添加到listview1中
Dim rs1 As New ADODB.Recordset '定义记录集，用于打开用户信息表
Dim rs2 As New ADODB.Recordset
Dim Mystr As String '定义字符串，用于获取用户名
Dim itmX As ListItem '声明一个ListItem对象
'打开用户信息表，并将所有用户名添加到listview中
rs2.Open "select * from Role_Info", DBCnn, adOpenStatic, adLockOptimistic
If rs2.RecordCount > 0 Then
rs2.MoveFirst
Do While rs2.EOF = False
Combo1.AddItem rs2.Fields("Role_Name")
rs2.MoveNext
Loop
rs2.Close
End If
rs1.Open "select Admin_Name from SysAd_Info where Admin_Name <> 'Admin'", DBCnn, adOpenStatic, adLockOptimistic
If rs1.RecordCount > 0 Then
rs1.Move First
Do While rs1.EOF = False
Mystr = rs1.Fields("Admin_Name")
Set itmX = ListView1.ListItems.Add(, , Mystr)
rs1.MoveNext
Loop
rs1.Close
End If
End Sub
Private Sub ListView1_Click() '当单击ListView1中相应用户时，在文本框中显示出该用户的信息
TxtName.Locked = True '修改用户名文本框
Dim rs2 As New ADODB.Recordset
rs2.Open "select Role_Name from Role_Info where Role_id in (select Role_id from SysAd_Info where Admin_Name='" + ListView1.SelectedItem + "')", DBCnn, adOpenStatic, adLockOptimistic
Dim rs3 As New ADODB.Recordset '定义记录集，用于打开在listview中选定的用户信息
rs3.Open "select * from SysAd_Info where Admin_Name='" + ListView1.SelectedItem + "'", DBCnn, adOpenStatic, adLockOptimistic
'将选定的用户信息显示出来
TxtName.Text = rs3.Fields("Admin_Name")
Txtsec.Text = rs3.Fields("Admin_SecNum")
Combo1.Text = rs2.Fields("Role_Name")
RTxtBox1.Text = rs3.Fields("Admin_Else")
If rs3.Fields("Times") >= 6 Then
TxtZT.Text = "被锁定"
Else
TxtZT.Text = "未锁定"
End If
rs3.Close
rs2.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -