📄 frmmanage.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Frmmanage
BorderStyle = 3 'Fixed Dialog
Caption = "用户管理"
ClientHeight = 3090
ClientLeft = 45
ClientTop = 435
ClientWidth = 7890
Icon = "Frmmanage.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3090
ScaleWidth = 7890
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame1
Caption = "添加新用户"
Height = 2835
Left = 4680
TabIndex = 6
Top = 120
Width = 3135
Begin VB.ComboBox Combo1
Height = 300
Left = 1320
Style = 2 'Dropdown List
TabIndex = 13
Top = 1800
Width = 1215
End
Begin VB.CommandButton Command1
Cancel = -1 'True
Caption = "退出（&X）"
Height = 375
Left = 1680
TabIndex = 11
Top = 2280
Width = 1035
End
Begin VB.CommandButton Command4
Caption = "添加（&A）"
Height = 375
Left = 240
TabIndex = 4
Top = 2280
Width = 1035
End
Begin VB.TextBox Text4
Height = 300
Left = 1320
TabIndex = 3
Top = 1404
Width = 1140
End
Begin VB.TextBox Text3
Height = 300
IMEMode = 3 'DISABLE
Left = 1320
MaxLength = 20
PasswordChar = "*"
TabIndex = 2
Top = 1011
Width = 1620
End
Begin VB.TextBox Text1
Height = 300
Left = 1320
TabIndex = 0
Top = 225
Width = 900
End
Begin VB.TextBox Text2
Height = 300
IMEMode = 3 'DISABLE
Left = 1320
MaxLength = 20
PasswordChar = "*"
TabIndex = 1
Top = 618
Width = 1620
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "用户权限："
Height = 180
Left = 180
TabIndex = 12
Top = 1860
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "用户名："
Height = 180
Left = 360
TabIndex = 10
Top = 285
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "密码："
Height = 180
Left = 540
TabIndex = 9
Top = 678
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "确认密码："
Height = 180
Index = 0
Left = 180
TabIndex = 8
Top = 1071
Width = 900
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "姓名："
Height = 180
Left = 540
TabIndex = 7
Top = 1464
Width = 540
End
End
Begin MSComctlLib.ListView ListView
Height = 2895
Left = 0
TabIndex = 5
ToolTipText = "双击删除用户"
Top = 120
Width = 4575
_ExtentX = 8070
_ExtentY = 5106
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Menu menuOperator
Caption = "用户管理"
Visible = 0 'False
Begin VB.Menu menuAdd
Caption = "添加用户"
End
Begin VB.Menu menu
Caption = "-"
End
Begin VB.Menu menuDel
Caption = "删除用户"
End
End
End
Attribute VB_Name = "Frmmanage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DelNO As Integer
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
'初始化ListView
Dim clmX As ColumnHeader
Set clmX = ListView.ColumnHeaders.Add(, , "用户名", ListView.Width / 3)
Set clmX = ListView.ColumnHeaders.Add(, , "密码", ListView.Width / 6, 2)
Set clmX = ListView.ColumnHeaders.Add(, , "姓名", ListView.Width / 4, 2)
Set clmX = ListView.ColumnHeaders.Add(, , "用户权限", ListView.Width / 4, 2)
Combo1.Clear
Combo1.AddItem "普通用户"
Combo1.AddItem "超级用户"
Combo1.ListIndex = 0
LoadOperator
End Sub
Private Sub Command4_Click()
On Error Resume Next
If Trim(Text1.Text) = "" Then
MsgBox "登陆用户名不允许为空！", vbOKOnly + 48, "提示："
Text1.SetFocus
Exit Sub
End If
If InStr(1, Trim(Text1.Text), "'", vbTextCompare) Then
MsgBox "用户姓名中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
Text1.SetFocus
Exit Sub
End If
If Trim(Text2.Text) = "" Then
MsgBox "密码不能为空，请输入密码！", vbOKOnly + 48, "提示："
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
Exit Sub
End If
If Trim(Text3.Text) <> Trim(Text2.Text) Then
MsgBox "两次密码不相同，请重输入！", vbOKOnly + 48, "提示："
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
Exit Sub
End If
Userid = Trim(Text1.Text)
Userpwd = MD5(Trim(Text2.Text))
Username = Trim(Text4.Text)
Userpower = Trim(Combo1.Text)
sqlstr = "select * from UserInfo where UserID='" & Text1.Text & "'"
rs.Open sqlstr, con, 1, 1
DelNO = rs.RecordCount
Do While Not rs.EOF
If Text1.Text = rs.Fields("UserID") Then
MsgBox "已经存在用户名为 " & Userid & " 的用户帐号", vbInformation
Text1.SetFocus
Exit Sub
End If
rs.MoveNext
Loop
rs.Close: Set rs = Nothing
'添加用户
MsgBox "添加用户" & Text1.Text & "成功", vbOKOnly, "添加系统用户"
sqlstr = "insert into UserInfo(UserID,UserPWD,UserName,UserPower)values('" & Userid & "','" & Userpwd & "','" & Username & "','" & Userpower & "')"
con.Execute sqlstr
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
'更新列表
LoadOperator
End Sub
Private Sub ListView_DblClick()
'删除用户
Call menuDel_Click
End Sub
Private Sub ListView_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu menuOperator
End If
End Sub
Private Sub menuAdd_Click()
'添加用户
Text1.SetFocus
End Sub
Private Sub menuDel_Click()
'删除用户
DeleteRecord
End Sub
Private Sub DeleteRecord()
'删除用户操作
On Error Resume Next
If ListView.SelectedItem.Selected Then
If DelNO <= 1 Then
MsgBox "只剩下一个用户帐号，不允许再删除！", vbInformation
ElseIf MsgBox("确定要删除用户名为" & ListView.SelectedItem.Text & "的用户帐号吗？", vbYesNo + 32 + vbDefaultButton2) = vbYes Then
sqlstr = "select * from UserInfo where UserID='" & ListView.SelectedItem.Text & "'"
rs.Open sqlstr, con, 1, 1
If MD5(InputBox("请输入该用户的密码：")) = rs.Fields("UserPWD") Then
sqlstr = "delete from UserInfo where UserID='" & ListView.SelectedItem.Text & "'"
con.Execute sqlstr
Else
MsgBox "对不起！您输入的密码不正确，删除该用户失败！", vbInformation
End If
LoadOperator
End If
End If
rs.Close: Set rs = Nothing
End Sub
Private Sub LoadOperator()
On Error Resume Next
Dim Listit As ListItem
ListView.ListItems.Clear
ListView.LabelEdit = lvwAuto
ListView.View = 3
Dim ef As New ADODB.Recordset, sqlstr As String
sqlstr = "select * from UserInfo"
ef.Open sqlstr, con, 1, 1
DelNO = ef.RecordCount
Do While Not ef.EOF
Set Listit = ListView.ListItems.Add(, , ef.Fields("UserID"))
Listit.SubItems(1) = "***"
Listit.SubItems(2) = ef("UserName")
Listit.SubItems(3) = ef("UserPower")
ef.MoveNext
Loop
Set ef = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -