📄 frmadmin.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmAdmin
BorderStyle = 3 'Fixed Dialog
Caption = "用户信息"
ClientHeight = 4830
ClientLeft = 45
ClientTop = 330
ClientWidth = 5805
Icon = "FrmAdmin.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4830
ScaleWidth = 5805
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSComctlLib.ImageList ImageList1
Left = 840
Top = 2760
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmAdmin.frx":0CCA
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView TreeView1
Height = 3735
Left = 120
TabIndex = 10
Top = 120
Width = 2655
_ExtentX = 4683
_ExtentY = 6588
_Version = 393217
Style = 7
FullRowSelect = -1 'True
ImageList = "ImageList1"
BorderStyle = 1
Appearance = 0
End
Begin VB.Frame frame1
Appearance = 0 'Flat
BackColor = &H80000004&
Caption = "用户信息"
ForeColor = &H80000008&
Height = 2295
Left = 2880
TabIndex = 6
Top = 120
Width = 2775
Begin VB.TextBox Text1
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 320
Index = 0
Left = 960
MaxLength = 30
TabIndex = 0
Top = 360
Width = 1455
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 320
IMEMode = 3 'DISABLE
Index = 1
Left = 960
PasswordChar = "*"
TabIndex = 1
Top = 960
Width = 1455
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 320
IMEMode = 3 'DISABLE
Index = 2
Left = 960
PasswordChar = "*"
TabIndex = 2
Top = 1560
Width = 1455
End
Begin VB.Label labName
Caption = "姓 名"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 9
Top = 360
Width = 735
End
Begin VB.Label labOrder
Caption = "密 码"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 8
Top = 960
Width = 735
End
Begin VB.Label labEnter
Caption = "确 认"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 7
Top = 1560
Width = 735
End
End
Begin VB.Frame frame2
Appearance = 0 'Flat
BackColor = &H80000004&
Caption = "权限设置"
ForeColor = &H80000008&
Height = 1335
Left = 2880
TabIndex = 5
Top = 2520
Width = 2775
Begin VB.OptionButton Option1
Caption = "一级权限(系统管理)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 240
TabIndex = 3
Top = 360
Width = 2295
End
Begin VB.OptionButton Option1
Caption = "二级权限(只能浏览)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 2
Left = 240
TabIndex = 4
Top = 720
Width = 2295
End
End
Begin VB.PictureBox cmdClose
Height = 495
Left = 4680
ScaleHeight = 435
ScaleWidth = 915
TabIndex = 11
ToolTipText = "关闭"
Top = 4200
Width = 975
End
Begin VB.PictureBox cmdDel
Height = 495
Left = 3480
ScaleHeight = 435
ScaleWidth = 915
TabIndex = 12
ToolTipText = "删除"
Top = 4200
Width = 975
End
Begin VB.PictureBox cmdRewrite
Height = 495
Left = 2400
ScaleHeight = 435
ScaleWidth = 915
TabIndex = 13
ToolTipText = "修改"
Top = 4200
Width = 975
End
Begin VB.PictureBox cmdAdd
Height = 495
Left = 1200
ScaleHeight = 435
ScaleWidth = 915
TabIndex = 14
ToolTipText = "新增"
Top = 4200
Width = 975
End
Begin VB.PictureBox cmdFresh
Height = 495
Left = 120
ScaleHeight = 435
ScaleWidth = 915
TabIndex = 15
ToolTipText = "刷新"
Top = 4200
Width = 975
End
Begin VB.Line Line1
X1 = 0
X2 = 5760
Y1 = 3960
Y2 = 3960
End
Begin VB.Shape Shape1
Height = 4815
Left = 0
Top = 0
Width = 5775
End
End
Attribute VB_Name = "FrmAdmin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim sqlstr, msgstr As String
Dim r As Integer '权限
Dim clickname As String
Private Sub cmdAdd_Click()
If rights <> 1 Then
MsgBox "对不起，您没有此权限！"
Exit Sub
End If
If Text1(0).Text = "" Then
MsgBox "请输入需要新增的用户名！", vbInformation, "警告"
Exit Sub
ElseIf Text1(1).Text <> Text1(2).Text Then
MsgBox "两次输入的密码不一致！", vbInformation, "警告"
Text1(1).SelStart = 0
Text1(1).Text = ""
Text1(2).Text = ""
Text1(1).SetFocus
Exit Sub
ElseIf r <> 1 And r <> 2 Then
MsgBox "请选择权限！", vbInformation, "警告"
Exit Sub
End If
If Not IsNumeric(Text1(1).Text) Then
MsgBox "请输入正确的密码！", vbOKOnly + vbExclamation, "警告"
Text1(1).SelStart = 0
Text1(1).Text = ""
Text1(2).Text = ""
Text1(1).SetFocus
Exit Sub
End If
If Text1(1).MaxLength > 10 Then
MsgBox "请重新输入,密码的数值不可以超过10位."
Text1(1).SelStart = 0
Text1(1).Text = ""
Text1(2).Text = ""
Text1(1).SetFocus
Exit Sub
End If
If Text1(1).MaxLength > 10 Then
MsgBox "请重新输入,密码的数值不可以超过10位."
Text1(1).SelLength = 0
Text1(1).Text = ""
Text1(1).SetFocus
Exit Sub
End If
sqlstr = "select * from admin_info where name=" & Chr(34) & Text1(0).Text & Chr(34)
Set rs = ExecuteSQL(sqlstr, msgstr)
If Not rs.EOF Then
MsgBox "该用户已存在！", vbInformation, "警告"
Exit Sub
Else
rs.AddNew
rs.Fields("name") = Trim(Text1(0).Text)
rs.Fields("password") = Trim(Text1(1).Text)
rs.Fields("rights") = r
rs.Update
rs.Close
mynod = TreeView1.Nodes.Add("admi", tvwChild, Text1(0).Text, Text1(0).Text, 1)
MsgBox "添加成功！"
Text1(1).Text = ""
Text1(2).Text = ""
End If
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdDel_Click()
If rights <> 1 Then
MsgBox "您没有这个权限！", vbInformation, "警告"
Exit Sub
End If
If clickname = username Then
MsgBox "用户" & checkName & "正在使用本系统，不能删除！", vbCritical, "错误"
ElseIf clickname = "" Then
MsgBox "请选择要删除的用户！"
Else
sqlstr = "select * from admin_info where name=" & Chr(34) & clickname & Chr(34)
Set rs = ExecuteSQL(sqlstr, msgstr)
If Not rs.EOF Then
msg = MsgBox("您确定要删除此用户吗？（不可恢复）", vbYesNo + vbInformation, "提示")
If msg = vbNo Then
Exit Sub
Else
rs.Delete
rs.Close
MsgBox "删除成功！"
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
Option1(1).Value = False
Option1(2).Value = False
TreeView1.Nodes.Remove (clickname)
TreeView1.Refresh
End If
Else
MsgBox "没有此用户，不能删除！", vbInformation, "错误"
End If
End If
End Sub
Private Sub cmdFresh_Click()
Text1(0).Enabled = True
Text1(1).Enabled = True
Text1(2).Enabled = True
If rights = 1 Then
Option1(1).Value = False
Option1(2).Value = False
End If
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
Text1(0).SetFocus
End Sub
Private Sub cmdRewrite_Click()
If Text1(0).Text = "" Then
MsgBox "请输入用户名！"
ElseIf Text1(1).Text <> Text1(2).Text Then
MsgBox "两次输入的新密码不一致！"
Exit Sub
ElseIf r <> 1 And r <> 2 Then
MsgBox "请选择权限！", vbInformation, "警告"
Exit Sub
ElseIf clickname <> username And rights = 2 Then
MsgBox "您无权修改其他用户的信息！"
Exit Sub
End If
sqlstr = "select * from admin_info where rights=1"
Set rs = ExecuteSQL(sqlstr, msgstr)
If rs.RecordCount = 1 And r = 2 And rs.Fields("name") = clickname Then
MsgBox "为保证系统的正常的运行,必须保留一个管理员权限！因此您不能修改此用户的权限", vbInformation, "警告"
Exit Sub
End If
rs.Close
sqlstr = "select * from admin_info where name=" & Chr(34) & clickname & Chr(34)
Set rs = ExecuteSQL(sqlstr, msgstr)
If Not rs.EOF Then
msg = MsgBox("您确定要修改此用户的基本信息吗？", vbYesNo + vbInformation)
If msg = vbNo Then
Exit Sub
Else
rs.Fields("name") = Trim(Text1(0).Text)
rs.Fields("password") = Trim(Text1(1).Text)
rs.Fields("rights") = r
rs.Update
rs.Close
MsgBox "修改成功!"
username = Text1(0).Text
Text1(1).Text = ""
Text1(2).Text = ""
TreeView1.Nodes.Clear
Call treeLoad
End If
End If
End Sub
Private Sub Form_Load()
Me.Top = (FrmMain.Height - Me.Height) / 4
Me.Left = (FrmMain.Width - Me.Width) / 2
If rights = 1 Then
Else
Option1(1).Enabled = False
Option1(2).Enabled = False
End If
Me.Picture = LoadPicture("")
Call treeLoad
End Sub
Private Sub treeLoad()
Dim mynod As Node
Set mynod = TreeView1.Nodes.Add(, , "admi", "用户", 1)
sqlstr = "select * from admin_info"
Set rs = ExecuteSQL(sqlstr, msgstr)
Do While Not rs.EOF
Set mynod = TreeView1.Nodes.Add("admi", tvwChild, rs.Fields("name"), rs.Fields("name"), 1)
rs.MoveNext
Loop
rs.Close
End Sub
Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 1
r = 1
Case 2
r = 2
End Select
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
If Node.Text <> "用户" Then
clickname = Node.Text
sqlstr = "select name,rights from admin_info where name=" & Chr(34) & Node.Text & Chr(34)
Set rs = ExecuteSQL(sqlstr, msgstr)
If Not rs.EOF Then
Text1(0).Text = rs.Fields("name")
Option1(rs.Fields("rights")).Value = True
End If
Else
Text1(0).Text = ""
Option1(1).Value = False
Option1(2).Value = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -