📄 formd5.frm
字号:
VERSION 5.00
Begin VB.Form FormD5
BackColor = &H00FFFF80&
Caption = " 修改密码"
ClientHeight = 4875
ClientLeft = 3855
ClientTop = 2640
ClientWidth = 9705
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 4875
ScaleWidth = 9705
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "退 出"
Height = 320
Left = 4680
TabIndex = 3
Top = 2805
Width = 975
End
Begin VB.CommandButton Command1
Caption = "确 定"
Height = 320
Left = 3600
TabIndex = 2
Top = 2805
Width = 975
End
Begin VB.TextBox Text2
Height = 270
IMEMode = 3 'DISABLE
Left = 4680
PasswordChar = "*"
TabIndex = 1
Text = "Text2"
Top = 1920
Visible = 0 'False
Width = 855
End
Begin VB.TextBox Text1
Height = 270
Left = 4680
TabIndex = 0
Text = "Text1"
Top = 1320
Width = 855
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00FFFF80&
Caption = "原 密 码："
Height = 180
Left = 3720
TabIndex = 5
Top = 1980
Visible = 0 'False
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00FFFF80&
Caption = "用户名称："
Height = 180
Left = 3720
TabIndex = 4
Top = 1380
Width = 900
End
End
Attribute VB_Name = "FormD5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
' ┃ Form65 修改密码 ┃
' ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
Option Explicit
' Public strUsd, strUsm, strUsk, strUsj As String ' 用户名、密码、级别及代码
Dim bytLgn As Byte, bolTc As Boolean
Dim strUnk As String, strUsk As String, StrUsm As String, StrUsj As String, strUsd As String
'
Private Sub Form_Load()
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
strT0 = "T_tm"
If myF_ExistT(strT0) < 1 Then ' 检查表 A_tm 记录
MsgBox " Not Find " & strT0 & " ... ", 48, " Error !"
bolTc = True
Exit Sub
End If
Set MyRs0 = New Recordset
StrSQL = "Select * From " & strT0 & " Where Left(Dm,2)='Kl' Order By Xh"
MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
If MyRs0.RecordCount > 0 Then
MyRs0.MoveLast
Else
MsgBox " Not Find Datas In " & strT0 & " ... ", 48, " Error !!"
bolTc = True
Exit Sub
End If
End Sub
Private Sub Form_Activate()
If bolTc = True Then
Unload Me
End If
strUnk = ""
bytLgn = 3
Text2.Text = ""
Text1.Text = "": Text1.SetFocus
End Sub
Private Sub Text1_Change() ' 检查用户名
StrUsm = Trim(Text1.Text)
If myF_Len(StrUsm) > 6 Then
MsgBox " 用户名最大长度为六个英文字符位，请修改 ... ", 48, " 请注意"
Text1.Text = Left(StrUsm, 6)
Text1.SetFocus ' 重新输入
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) ' 用户名
If KeyAscii = 13 Then
StrUsm = Trim(Text1.Text)
If StrUsm = "" Then
StrUsj = "3"
Command2.SetFocus ' Quit
Else
If P_HcUse(StrUsm) = True Then ' 用户名通过
Call P_xxxx
Else ' 用户名未通过
If bytLgn = 0 Then
MsgBox " 很抱歉，用户名不符 ... ", 48, " 输入错误 !!!"
StrUsj = "3"
Unload Me
Exit Sub
End If
End If
End If
End If
End Sub
Function P_HcUse(Usn As String) As Boolean ' 核对用户名
MyRs0.MoveFirst
If Usn = StrUsm Then
P_HcUse = True
Exit Function
End If
bytLgn = bytLgn - 1 ' 错
If bytLgn = 0 Then
P_HcUse = False ' 用户名不符
Else
MsgBox " 请再输入一次用户名 ... ", 48, " 输入错误 " & IIf(bytLgn = 1, "!!", "!")
Text1 = ""
P_HcUse = False
End If
End Function
Private Sub P_xxxx() ' 按名取记录集合
Set MyRs1 = New Recordset
StrSQL = "Select * From " & strT0 & " Where Left(Dm,2)='Kl' And Mc='" & StrUsm & "'"
MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
If MyRs1.RecordCount < 1 Then
MsgBox " Not Find Datas On " & StrUsm & " ... ", 48, " Error !!!"
StrUsj = "3"
Unload Me
Exit Sub
End If
bytLgn = 3
Text1.Enabled = False
Text2.Visible = True: Label2.Visible = True
Text2.SetFocus
End Sub
Private Sub Text2_Change() ' 检查密码
strUsk = Trim(Text2.Text)
If strUsk = "" Then Exit Sub
If myF_Len(strUsk) > 6 Then
MsgBox " 密码最大长度为六个英文字符位，请修改 ... ", 48, " 请注意"
Text2.Text = Left(strUsk, 6)
Text2.SetFocus ' 重新输入
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer) ' txtPassword
If KeyAscii <> 13 Then Exit Sub
strUsk = Trim(Text2.Text)
If Label2.Caption Like "原*" Then
If strUsk = "" Then
Command2.SetFocus ' Quit
Else
If P_HcKls(strUsk) = True Then ' 密码通过
Label2.Caption = "新 密 码："
Text2.Text = ""
Text2.SetFocus
Else ' 密码未通过
If bytLgn = 0 Then
MsgBox " 很抱歉，密码不符 ... ", 48, " 输入错误 !!!"
StrUsj = "3"
Unload Me
End If
End If
End If
Else ' 新密码
If strUsk = "" Then
Command2.SetFocus ' Quit
Exit Sub
End If
If Label2.Caption Like "新*" Then
strUnk = strUsk
Label2.Caption = "再输一次："
Text2.Text = ""
Text2.SetFocus
Else
If strUnk = strUsk Then ' 通过
Command1.SetFocus
Else
MsgBox " 密码修改失败 ... ", 48, " Ok !"
Unload Me
End If
End If
End If
End Sub
Function P_HcKls(Usk As String) As Boolean ' 核对密码
MyRs1.MoveFirst
Do While Not MyRs1.EOF
'MsgBox Usk & "-" & Trim(myRs0![Jc])
If Usk = Trim(MyRs1![Jc]) Then
strUsd = MyRs1![dm]
StrUsm = MyRs1![Mc]
' strUsj = Trim(myRs1![Bz])
P_HcKls = True
Exit Function
Exit Do
End If
MyRs1.MoveNext
Loop
bytLgn = bytLgn - 1 ' 无
If bytLgn = 0 Then
P_HcKls = False ' 密码不符
Else
MsgBox " 请再输入一次密码 ... ", 48, " 登录错误 " & IIf(bytLgn = 1, "!!", "!")
Text2 = ""
P_HcKls = False
End If
End Function
Private Sub Command1_KeyPress(KeyAscii As Integer) ' cmdOK
If KeyAscii = 13 Then Call Command1_Click
End Sub
Private Sub Command1_Click() ' 确认处理
StrUsm = Trim(Text1.Text) ' 核对用户名
If StrUsm = "" Then
Command2.SetFocus: Exit Sub ' Quit
End If
If P_HcUse(StrUsm) = False Then ' 未通过
If bytLgn = 0 Then
MsgBox " 很抱歉，用户名不符 kk ... ", 48, " 登录错误 !!!"
StrUsj = "3"
Unload Me
Else
Text1.Text = ""
Text1.SetFocus ' 准备重新输入
End If
Exit Sub
End If
If Text2.Visible = False Then
Call P_xxxx ' 按名取记录集
Exit Sub
End If
strUsk = Trim(Text2.Text) ' 核对密码
If strUsk = "" Then
Command2.SetFocus: Exit Sub ' Quit
End If
If Label2.Caption Like "原" Then
If P_HcKls(strUsk) = False Then ' 未通过
If bytLgn = 0 Then
MsgBox " 很抱歉，密码不符 ... ", 48, " 登录错误 !!!"
StrUsj = "3"
Unload Me
Else
Text2.Text = ""
Text2.SetFocus ' 重新输入
End If
Exit Sub
Else ' 密码通过
Label2.Caption = "新 密 码："
Text2.Text = ""
Text2.SetFocus
End If
Else ' 新密码
If Label2.Caption Like "新" Then
strUnk = strUsk
Label2.Caption = "再输一次："
Else '
If strUnk = strUsk Then
MyRs1![Jc] = strUsk
MyRs1.Update
StrMsg = "完毕"
Else
StrMsg = "失败"
End If
MsgBox " 密码修改" & StrMsg & " ... ", 48, " Ok !"
Unload Me
End If
End If
End Sub
Private Sub Command2_Click() ' cmdCancel
StrUsj = "3"
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MyRs0.Close: Set MyRs0 = Nothing
MyRs1.Close: Set MyRs1 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -