📄 frmusrmgmt.frm
字号:
VERSION 5.00
Begin VB.Form frmUsrMgmt
BorderStyle = 1 'Fixed Single
Caption = "用户管理"
ClientHeight = 3705
ClientLeft = 45
ClientTop = 330
ClientWidth = 6315
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 3705
ScaleWidth = 6315
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox pic
Appearance = 0 'Flat
BackColor = &H00808080&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 330
Left = 0
ScaleHeight = 330
ScaleWidth = 6555
TabIndex = 12
Top = 0
Width = 6555
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "更改用户密码以及创建新的用户"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 210
Index = 0
Left = 120
TabIndex = 14
Top = 60
Width = 3150
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "更改用户密码以及创建新的用户"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 150
TabIndex = 13
Top = 90
Width = 3150
End
End
Begin VB.Frame fr
Height = 3435
Index = 0
Left = 0
TabIndex = 10
Top = 270
Width = 6315
Begin VB.Frame fr
Caption = "更改密码"
Height = 3015
Index = 1
Left = 120
TabIndex = 20
Top = 300
Width = 2985
Begin VB.TextBox txt
Height = 270
Index = 0
Left = 840
MaxLength = 10
TabIndex = 0
Top = 510
Width = 1935
End
Begin VB.TextBox txt
Height = 270
IMEMode = 3 'DISABLE
Index = 1
Left = 840
MaxLength = 15
PasswordChar = "*"
TabIndex = 1
Top = 870
Width = 1935
End
Begin VB.TextBox txt
Height = 270
IMEMode = 3 'DISABLE
Index = 2
Left = 840
MaxLength = 15
PasswordChar = "*"
TabIndex = 2
Top = 1230
Width = 1935
End
Begin VB.TextBox txt
Height = 270
IMEMode = 3 'DISABLE
Index = 3
Left = 840
MaxLength = 15
PasswordChar = "*"
TabIndex = 3
Top = 1590
Width = 1935
End
Begin VB.CommandButton cmdModifyPwd
Caption = "更改(&M)"
Default = -1 'True
Height = 345
Left = 1440
TabIndex = 4
Top = 2460
Width = 1275
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "用户名"
Height = 180
Index = 2
Left = 180
TabIndex = 24
Top = 540
Width = 540
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "旧密码"
Height = 180
Index = 3
Left = 180
TabIndex = 23
Top = 915
Width = 540
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "新密码"
Height = 180
Index = 4
Left = 180
TabIndex = 22
Top = 1275
Width = 540
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "确认"
Height = 180
Index = 5
Left = 180
TabIndex = 21
Top = 1650
Width = 360
End
End
Begin VB.Frame fr
Caption = "创建用户"
Height = 3015
Index = 2
Left = 3180
TabIndex = 15
Top = 300
Width = 3015
Begin VB.TextBox txt
Height = 270
Index = 7
Left = 930
MaxLength = 5
TabIndex = 8
Top = 1560
Width = 1935
End
Begin VB.TextBox txt
Height = 270
Index = 4
Left = 930
MaxLength = 10
TabIndex = 5
Top = 480
Width = 1935
End
Begin VB.TextBox txt
Height = 270
IMEMode = 3 'DISABLE
Index = 5
Left = 930
MaxLength = 15
PasswordChar = "*"
TabIndex = 6
Top = 840
Width = 1935
End
Begin VB.CommandButton cmdCreateUser
Caption = "创建(&S)"
Height = 345
Left = 1440
TabIndex = 11
Top = 2460
Width = 1275
End
Begin VB.ComboBox cboDept
Height = 300
Left = 930
Style = 2 'Dropdown List
TabIndex = 9
Top = 1920
Width = 1935
End
Begin VB.TextBox txt
Height = 270
IMEMode = 3 'DISABLE
Index = 6
Left = 930
MaxLength = 15
PasswordChar = "*"
TabIndex = 7
Top = 1200
Width = 1935
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "姓名"
Height = 180
Index = 9
Left = 180
TabIndex = 25
Top = 1620
Width = 360
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "用户名"
Height = 180
Index = 6
Left = 180
TabIndex = 19
Top = 510
Width = 540
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "密码"
Height = 180
Index = 7
Left = 180
TabIndex = 18
Top = 885
Width = 360
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "所在部门"
Height = 180
Index = 10
Left = 180
TabIndex = 17
Top = 1980
Width = 720
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "确认"
Height = 180
Index = 8
Left = 180
TabIndex = 16
Top = 1245
Width = 360
End
End
End
End
Attribute VB_Name = "frmUsrMgmt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************
'* 企业内部业务联系系统 1.0版 *
'* *
'* 作者：郭文云(云南电信昭通分公司) *
'* 日期：2004年8月 *
'* 版权：Terrificsoft *
'* 版权所有 侵权必究 *
'****************************************
Option Explicit
'修改用户密码
Private Sub cmdModifyPwd_Click()
On Error GoTo ErrorHandler
Dim strSQL As String
'输入合法才更改密码
If CanChangePwd Then
Set RsAdo = New Recordset
'构造SQL语句（不要忘记过滤单引号）
strSQL = "UPDATE tblUser SET UserPwd='" & RealString(txt(2)) _
& "' WHERE UserName='" & RealString(txt(0)) & "'"
RsAdo.Open strSQL, AdoCon, adOpenStatic, adLockReadOnly
CloseRsAdo
MsgBox "密码修改成功！", vbInformation, "修改密码"
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical, "出现错误"
Exit Sub
End Sub
'系统管理员创建新用户
Private Sub cmdCreateUser_Click()
On Error GoTo ErrorHandler
Dim strSQL As String
'再次用户权限认证
If UserDept <> "系统管理员" Then Exit Sub
'输入合法才创建用户
If CanCreateUser Then
Set RsAdo = New Recordset
'构造SQL语句（不要忘记过滤单引号）
strSQL = "INSERT INTO tblUser(UserName,UserPwd,TrueName,DeptUserIn) " _
& "VALUES ('" & RealString(txt(4)) & "','" & RealString(txt(5)) & "','" _
& RealString(txt(7)) & "','" & RealString(cboDept.Text) & "')"
RsAdo.Open strSQL, AdoCon, adOpenStatic, adLockReadOnly
CloseRsAdo
MsgBox "创建新用户成功！", vbInformation, "创建用户"
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical, "出现错误"
Exit Sub
End Sub
'验证用户修改密码的输入是否符合设定
Private Function CanChangePwd() As Boolean
On Error GoTo ErrorHandler
Dim i As Long
'文本不能为空
For i = 0 To 3
If txt(i) = "" Then
MsgBox "输入不能为空。", vbInformation, "请重试"
Exit Function
End If
Next i
'旧用户信息验证
Set RsAdo = New Recordset
RsAdo.Open "SELECT UserName FROM tblUser WHERE UserName='" & _
txt(0) & "' AND UserPwd='" & txt(1) & "'", _
AdoCon, adOpenStatic, adLockReadOnly
If RsAdo.EOF Then
MsgBox "用户名或旧密码错误，请重试。", vbInformation, "请重试"
Exit Function
End If
CloseRsAdo
'两次新密码输入必须匹配
If txt(2) <> txt(3) Then
MsgBox "两次输入的密码并不一致，请重试。", vbInformation, "请重试"
Exit Function
End If
'返回值
CanChangePwd = True
Exit Function
ErrorHandler:
Exit Function
End Function
'验证创建新用户的输入是否符合设定
Private Function CanCreateUser() As Boolean
On Error GoTo ErrorHandler
Dim i As Long
'文本不能为空
For i = 4 To 7
If txt(i) = "" Then
MsgBox "输入不能为空。", vbInformation, "请重试"
Exit Function
End If
Next i
'不能添加已存在的用户
Set RsAdo = New Recordset
RsAdo.Open "SELECT UserName FROM tblUser WHERE UserName='" & txt(4) & "'", AdoCon, adOpenStatic, adLockReadOnly
If RsAdo.RecordCount > 0 Then
MsgBox "用户名为" & txt(4) & "的用户已经存在！", vbInformation, "请重试"
Exit Function
End If
'两次密码输入必须匹配
If txt(5) <> txt(6) Then
MsgBox "两次输入的密码并不一致，请重试。", vbInformation, "请重试"
Exit Function
End If
'返回值
CanCreateUser = True
Exit Function
ErrorHandler:
Exit Function
End Function
'初始化组合框并控制权限
Private Sub Form_Load()
AddComboItems cboDept
cboDept.AddItem UserDept
If UserDept <> "系统管理员" Then cmdCreateUser.Enabled = False
End Sub
'在文本框被激活时选定全部文本
Private Sub txt_GotFocus(Index As Integer)
txt(Index).SelStart = 0
txt(Index).SelLength = Len(txt(Index))
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -