📄 frm_sys_set.frm
字号:
VERSION 5.00
Begin VB.Form Frm_sys_set
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
Caption = "账号管理"
ClientHeight = 4350
ClientLeft = 4050
ClientTop = 3450
ClientWidth = 7305
LinkTopic = "Form8"
ScaleHeight = 290
ScaleMode = 3 'Pixel
ScaleWidth = 487
ShowInTaskbar = 0 'False
Begin Project1.xp_canvas xp_canvas1
Height = 4335
Left = 0
TabIndex = 0
Top = 0
Width = 7215
_ExtentX = 12726
_ExtentY = 7646
Caption = "账号管理"
Icon = "Frm_sys_set.frx":0000
Begin Project1.xpcmdbutton Command4
Height = 375
Left = 5160
TabIndex = 13
Top = 3360
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Caption = "退 出"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Project1.xpcmdbutton Command3
Height = 375
Left = 3600
TabIndex = 12
Top = 3360
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Caption = "删除账号"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Project1.xpcmdbutton Command2
Height = 375
Left = 2040
TabIndex = 11
Top = 3360
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Caption = "修改账号"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Project1.xpcmdbutton Command1
Height = 375
Left = 480
TabIndex = 10
Top = 3360
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Caption = "增加账号"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.ListBox List1
BeginProperty Font
Name = "新宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2220
Left = 4320
TabIndex = 5
Top = 960
Width = 2295
End
Begin VB.Frame Frame1
Height = 2655
Left = 240
TabIndex = 1
Top = 600
Width = 4095
Begin VB.TextBox Text3
BeginProperty Font
Name = "新宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1440
TabIndex = 9
Top = 1800
Width = 2175
End
Begin VB.TextBox Text2
BeginProperty Font
Name = "新宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
IMEMode = 3 'DISABLE
Left = 1440
PasswordChar = "*"
TabIndex = 8
Top = 1080
Width = 2175
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "新宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1440
TabIndex = 7
Top = 360
Width = 2175
End
Begin VB.Label Label3
Caption = "用户权限级别"
Height = 495
Left = 120
TabIndex = 4
Top = 1920
Width = 1215
End
Begin VB.Label Label2
Caption = "用户密码"
Height = 495
Left = 120
TabIndex = 3
Top = 1080
Width = 1215
End
Begin VB.Label Label1
Caption = "用户账号"
Height = 495
Left = 120
TabIndex = 2
Top = 360
Width = 1215
End
End
Begin Project1.xptopbuttons xptopbuttons2
Height = 315
Left = 6480
Top = 120
Width = 315
_ExtentX = 556
_ExtentY = 556
Value = 2
End
Begin Project1.xptopbuttons xptopbuttons1
Height = 315
Left = 6840
Top = 120
Width = 315
_ExtentX = 556
_ExtentY = 556
End
Begin VB.Label Label4
Caption = "用户账号列表 :"
BeginProperty Font
Name = "新宋体"
Size = 12
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404040&
Height = 375
Left = 4320
TabIndex = 6
Top = 600
Width = 2175
End
End
End
Attribute VB_Name = "Frm_sys_set"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public inx As Integer '用户列表的索引号
Private Sub Command1_Click() '增加账号
Dim user As userdata
Dim ans As String '用户选择
Dim sql, ss As String
ss = CStr(Trim(Text1.Text))
If Trim(Text1.Text) = "" Then
frmMsg.Show
frmMsg.notice.Visible = True
frmMsg.Text1.Text = "用户名不能为空！"
Text1.SetFocus
Exit Sub
End If
'检测用户名是否已经存在
sql = "select * from user_table where [登录名]='" & ss & " '"
rst.Close
rst.Open sql, con, adOpenDynamic, adLockOptimistic
If rst.RecordCount > 0 Then
Msgbox "用户账号" & ss & "已存在!", vbInformation, "提示！"
Exit Sub
End If
'检测用户权限数是否在规定值之间
'1：数据浏览者；
'2：借书管理员；
'3：还书管理员；
'4：系统管理员
If Not (Trim(Text3.Text) < 5 And Trim(Text3.Text) > 0) Then
frmMsg.Show
frmMsg.notice.Visible = True
frmMsg.Text1.Text = "用户权限级别必须是1--4之间的整数！"
Exit Sub
End If
'添加新记录
user.user_id = CStr(LTrim(Text1.Text))
user.pwd = CStr(LTrim(Text2.Text))
user.right = LTrim(Text3.Text)
ans = Msgbox("增加用户吗？", vbOKCancel + vbInformation, "提示！")
If ans = vbOK Then
rst.AddNew
rst![登录名] = user.user_id
rst![密码] = user.pwd
rst![权限] = user.right
rst.Update
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
List1.AddItem rst![登录名]
Command3.Enabled = True
Exit Sub
Else
Exit Sub
End If
End Sub
Private Sub Command2_Click() '修改账号
Dim ss As String
Dim sql As String
ss = CStr(Trim(Text1.Text))
If Trim(Text1.Text) = "" Then
frmMsg.Show
frmMsg.notice.Visible = True
frmMsg.Text1.Text = "你没有选择要编辑的信息！"
Text1.SetFocus
Exit Sub
End If
'修改用户信息
If inx <> -1 Then
sql = "UPDATE" & " user_table " & " SET [登录名] ='" & Trim(Text1.Text) & "'" & " where [登录名] = '" & Trim(List1.List(inx)) & "'"
con.BeginTrans '启动事务
con.Execute sql '执行查询
con.CommitTrans '保存所有更改并退出事务
sql = "UPDATE" & " user_table " & " SET [密码] ='" & Trim(Text2.Text) & "'" & " where [登录名] = '" & Trim(List1.List(inx)) & "'"
con.BeginTrans
con.Execute sql
con.CommitTrans
sql = "UPDATE" & " user_table " & " SET [权限] ='" & Trim(Text3.Text) & "'" & " where [登录名]= '" & Trim(List1.List(inx)) & "'"
con.BeginTrans
con.Execute sql
con.CommitTrans
List1.AddItem (Trim(Text1.Text))
List1.RemoveItem (inx)
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End If
End Sub
Private Sub Command3_Click() '删除账号
Dim ans As String
If inx = -1 Then '没有选择要删除的项
frmMsg.Show
frmMsg.notice.Visible = True
frmMsg.Text1.Text = "请挑选要删除的项！"
Exit Sub
End If
If Not rst.EOF Then '如果不是最后一个用户记录
ans = Msgbox("确实要删除此用户吗？", vbOKCancel + vbInformation, "提示！")
If ans = vbOK Then
List1.RemoveItem (inx) '索引显示删除
rst.Delete '删除表内记录
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
inx = -1
Else
Exit Sub
End If
Else
Command2.Enabled = False
Command3.Enabled = False
End If
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer
inx = -1 '初始值定为-1
Call open_connection("user_table") '打开user_table表
For i = 0 To rst.RecordCount - 1 '显示用户列表
List1.AddItem rst![登录名]
rst.MoveNext
Next i
End Sub
Private Sub List1_Click()
Dim sql As String
'选择要修改的用户记录，根据索引显示用户信息
inx = List1.ListIndex
sql = "select * from user_table where [登录名] ='" & Trim(List1.List(inx)) & "'"
rst.Close
rst.Open sql, con, adOpenDynamic, adLockOptimistic
Text1.Text = rst![登录名]
Text2.Text = rst![密码]
Text3.Text = rst![权限]
End Sub
Private Sub xptopbuttons1_Click()
Unload Me
End Sub
Private Sub xptopbuttons2_Click()
Me.WindowState = 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -