📄 帐号.frm
字号:
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1500
TabIndex = 35
Top = 0
Width = 1500
End
Begin VB.Label lblTitle1
Alignment = 2 'Center
BackColor = &H00FFC0C0&
Caption = "增加帐号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 0
TabIndex = 11
Top = 0
Width = 1500
End
End
Attribute VB_Name = "zhanghao"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAdd_Click()
If Trim(txtUserName.Text) = "" Then
MsgBox "帐号不能为空!", vbOKOnly + vbExclamation, App.Title
txtUserName.SetFocus
Exit Sub
ElseIf txtPassword.Text = "" Then
txtPassword.SetFocus
MsgBox "密码不能为空!", vbOKOnly + vbExclamation, App.Title
Exit Sub
ElseIf txtPasswordAgain.Text = "" Then
txtPasswordAgain.SetFocus
MsgBox "确认密码不能为空!", vbOKOnly + vbExclamation, App.Title
Exit Sub
ElseIf txtPasswordAgain.Text <> txtPassword.Text Then
MsgBox "两次输入的密码不一致!", vbOKOnly + vbExclamation, App.Title
txtPassword.SetFocus
txtPassword.Text = ""
txtPasswordAgain.Text = ""
Exit Sub
ElseIf TheLevel.Text = "" Then
TheLevel.SetFocus
MsgBox "请选择该帐号拥有的权限!", vbOKOnly + vbExclamation, App.Title
Exit Sub
Else
sql = "select * from [用户登录] where [帐号]='" & txtUserName.Text & "'"
rs.Open sql, conn, 1, 3
If rs.EOF = False Then
MsgBox "此帐号已经存在,只能增加不同的帐号名称!", vbOKOnly + vbExclamation, App.Title
txtUserName.Text = ""
txtUserName.SetFocus
rs.Close
Set rs = Nothing
Exit Sub
End If
rs.AddNew
rs.Fields("帐号") = Trim(txtUserName.Text)
rs.Fields("密码") = txtPassword.Text
If TheLevel.Text = "普通" Then
rs.Fields("等级") = 1
ElseIf TheLevel.Text = "中级" Then
rs.Fields("等级") = 2
Else
rs.Fields("等级") = 3
End If
rs.Update
MsgBox "添加帐号成功!", vbOKOnly + vbInformation, App.Title
rs.Close
Set rs = Nothing
Unload Me
End If
End Sub
Private Sub cmdAddCancel_Click()
Unload Me
End Sub
Private Sub cmdDel_Click()
If MsgBox("确定要删除【" & txtDelUser.Text & "】这个帐号吗?", vbYesNo, "警告") = vbYes Then
sql = "Select * from [用户登录] where [帐号]='" & txtDelUser.Text & "'"
rs.Open sql, conn, 1, 3
rs.Delete
rs.Update
MsgBox "成功地将帐号【" & txtDelUser.Text & "】删除了!", vbOKOnly + vbInformation, App.Title
txtSearchDel.Text = ""
txtDelUser.Text = ""
txtDelPass.Text = ""
txtDelUser.Enabled = False
txtDelPass.Enabled = False
cmdDel.Enabled = False
rs.Close
Set rs = Nothing
End If
txtSearchModify.SetFocus
End Sub
Private Sub cmdDelCancel_Click()
Unload Me
End Sub
Private Sub cmdModify_Click()
If txtModifyUser.Text = "" Then
MsgBox "帐号不能为空!"
txtModifyUser.SetFocus
Exit Sub
ElseIf txtModifyPass.Text = "" Then
MsgBox "密码不能为空!"
txtModifyPass.SetFocus
Exit Sub
ElseIf ModifyLevel.Text = "" Then
MsgBox "请选择该帐号拥有的权限!"
txtModifyUser.SetFocus
Exit Sub
End If
sql = "select * from [用户登录] where [帐号]='" & txtModifyUser.Text & "'"
rs.Open sql, conn, 1, 3
rs.Fields("帐号") = txtModifyUser.Text
rs.Fields("密码") = txtModifyPass.Text
If ModifyLevel.Text = "普通" Then
rs.Fields("等级") = 1
ElseIf ModifyLevel.Text = "中级" Then
rs.Fields("等级") = 2
Else
rs.Fields("等级") = 3
End If
If chkNoLogin.Value = Checked Then
rs.Fields("是否禁用") = True
Else
rs.Fields("是否禁用") = False
End If
rs.Update
MsgBox "修改帐号成功!", vbOKOnly + vbInformation, App.Title
txtSearchModify.SetFocus
txtModifyUser.Text = ""
txtModifyPass.Text = ""
ModifyLevel.Text = "普通"
txtModifyPass.Enabled = False
ModifyLevel.Enabled = False
cmdModify.Enabled = False
chkNoLogin.Enabled = False
rs.Close
Set rs = Nothing
End Sub
Private Sub cmdMofidyCancel_Click()
Unload Me
End Sub
Private Sub cmdSearchDel_Click()
If Trim(txtSearchDel.Text) = "" Then
MsgBox "请输入要查询的帐号!", vbOKOnly + vbExclamation, App.Title
Exit Sub
Else
sql = "select * from [用户登录] where [帐号]='" & Trim(txtSearchDel.Text) & "'"
rs.Open sql, conn, 1, 3
If rs.EOF Then
MsgBox "没有找到名称为【" & txtSearchDel.Text & "】的帐号!"
rs.Close
Set rs = Nothing
Exit Sub
Else
txtDelUser.Enabled = True
txtDelPass.Enabled = True
cmdDel.Enabled = True
txtDelUser.Text = rs.Fields("帐号")
txtDelPass.Text = rs.Fields("密码")
If txtDelUser.Text = "admin" Then
txtDelPass.Text = "隐藏"
cmdDel.Enabled = False
End If
End If
txtSearchDel.Text = ""
txtSearchDel.SetFocus
rs.Close
Set rs = Nothing
End If
End Sub
Private Sub cmdSearchModify_Click()
If Trim(txtSearchModify.Text) = "" Then
MsgBox "请输入要查询的帐号!", vbOKOnly + vbExclamation, App.Title
txtSearchModify.SetFocus
Exit Sub
Else
sql = "select * from [用户登录] where [帐号]='" & Trim(txtSearchModify.Text) & "'"
rs.Open sql, conn, 1, 3
If rs.EOF Then
MsgBox "没有找到名称为【" & txtSearchModify.Text & "】的帐号!"
rs.Close
Set rs = Nothing
Exit Sub
Else
txtModifyPass.Enabled = True
ModifyLevel.Enabled = True
cmdModify.Enabled = True
chkNoLogin.Enabled = True
txtModifyUser.Text = rs.Fields("帐号")
txtModifyPass.Text = rs.Fields("密码")
If rs.Fields("等级") = 1 Then
ModifyLevel.Text = "普通"
ElseIf rs.Fields("等级") = 2 Then
ModifyLevel.Text = "中级"
ElseIf rs.Fields("等级") = 3 Then
ModifyLevel.Text = "高级"
End If
'超级管理帐号不允许修改的处理
If txtModifyUser.Text = "admin" Then
txtModifyPass.Text = "隐藏"
chkNoLogin.Enabled = False
cmdModify.Enabled = False
End If
If rs.Fields("是否禁用") = True Then
chkNoLogin.Value = 1
Else
chkNoLogin.Value = 0
End If
End If
txtSearchModify.Text = ""
txtSearchModify.SetFocus
rs.Close
Set rs = Nothing
End If
End Sub
Private Sub Form_Load()
Call CheckLogin(Me)
Call SetCenter(Me)
Call zhanghaoSet(Me)
Call OpenDB
sql = "Select [权限] from [管理权限]"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
TotalNum = rs.RecordCount
For i = 1 To TotalNum
TheLevel.AddItem rs.Fields("权限")
ModifyLevel.AddItem rs.Fields("权限")
rs.MoveNext
Next i
rs.Close
Set rs = Nothing
lblTitle1_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call CloseDB
End Sub
Private Sub lblTitle1_Click()
picAdd.Visible = True
picModify.Visible = False
picDel.Visible = False
End Sub
Private Sub lblTitle2_Click()
picModify.Visible = True
picAdd.Visible = False
picDel.Visible = False
End Sub
Private Sub lblTitle3_Click()
picDel.Visible = True
picAdd.Visible = False
picModify.Visible = False
End Sub
Private Sub txtSearchDel_Change()
If Len(Trim(txtSearchDel.Text)) > 0 Then
cmdSearchDel.Default = True
Else
cmdSearchDel.Default = False
End If
End Sub
Private Sub txtSearchModify_Change()
If Len(Trim(txtSearchModify.Text)) > 0 Then
cmdSearchModify.Default = True
Else
cmdSearchModify.Default = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -