📄 dlgpassword.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form dlgPassword
BorderStyle = 3 'Fixed Dialog
Caption = "修改密码"
ClientHeight = 1845
ClientLeft = 45
ClientTop = 330
ClientWidth = 4350
Icon = "dlgPassword.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1845
ScaleWidth = 4350
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 3120
TabIndex = 4
Top = 1320
Width = 975
End
Begin VB.TextBox txtNewPass
Height = 300
IMEMode = 3 'DISABLE
Left = 1680
MaxLength = 16
PasswordChar = "*"
TabIndex = 1
Top = 480
Width = 2415
End
Begin VB.TextBox txtOldPass
Height = 300
IMEMode = 3 'DISABLE
Left = 1680
MaxLength = 16
PasswordChar = "*"
TabIndex = 0
Top = 120
Width = 2415
End
Begin VB.TextBox txtReplyPass
Height = 300
IMEMode = 3 'DISABLE
Left = 1680
MaxLength = 16
PasswordChar = "*"
TabIndex = 2
Top = 840
Width = 2415
End
Begin VB.CommandButton cmdOK
Caption = "确定(&O)"
Height = 375
Left = 2160
TabIndex = 3
Top = 1320
Width = 975
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 300
Index = 0
Left = 240
TabIndex = 5
Top = 120
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Bevel = 2
Text = "旧的系统密码："
TextSave = "旧的系统密码："
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 300
Index = 1
Left = 240
TabIndex = 6
Top = 480
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Bevel = 2
Text = "新的系统密码："
TextSave = "新的系统密码："
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 300
Index = 2
Left = 240
TabIndex = 7
Top = 840
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Bevel = 2
Text = "重复一次密码："
TextSave = "重复一次密码："
EndProperty
EndProperty
End
End
Attribute VB_Name = "dlgPassword"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_tagErrInfo As TYPE_ERRORINFO '错误信息
Dim m_sDateBase As String
Dim m_iCode As Integer
Private Sub cmdCancel_Click()
On Error Resume Next
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo ERROR_EXIT
Dim sPass As String, sCliper As String
Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
Dim strSQL As String, sData As String
sPass = ""
sCliper = ""
If Trim$(txtOldPass.Text) <> "" Then
sPass = txtOldPass.Text
modCipher.Cipher "CoBeyond_Queue_Yixing", sPass, sCliper
End If
'连接数据库
cmd.ActiveConnection = dbMyDB
cmd.CommandType = adCmdText
'查询数据库
Select Case m_sDateBase
Case "Employee"
strSQL = "SELECT * FROM Employee WHERE ep_id = '" & m_iCode & "'"
Case "QFUser"
strSQL = "SELECT * FROM QFUser WHERE ku_id = '" & m_iCode & "'"
Case Else
Set rs = Nothing
Set cmd = Nothing
Unload Me
End Select
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenDynamic, adLockOptimistic
If Not rs.EOF And rs.RecordCount > 0 Then
Select Case m_sDateBase
Case "Employee"
If IsNull(rs!Property) Then
sData = ""
Else
sData = Trim$(rs!Property)
End If
If Trim$(sCliper) <> sData Or Trim$(txtNewPass.Text) <> Trim$(txtReplyPass.Text) Then
MsgBox "输入的密码不正确,请重新输入！", vbOKOnly, "系统提示"
txtOldPass.Text = ""
txtNewPass.Text = ""
txtReplyPass.Text = ""
txtOldPass.SetFocus
Set rs = Nothing
Set cmd = Nothing
Exit Sub
End If
'加密密码
sPass = ""
sCliper = ""
If Trim$(txtNewPass.Text) <> "" Then
sPass = txtNewPass.Text
modCipher.Cipher "CoBeyond_Queue_Yixing", sPass, sCliper
End If
rs!Property = sCliper
rs.Update
Case "QFUser"
If IsNull(rs!ku_password) Then
sData = ""
Else
sData = Trim$(rs!ku_password)
End If
If Trim$(sCliper) <> sData Or Trim$(txtNewPass.Text) <> Trim$(txtReplyPass.Text) Then
MsgBox "输入的密码不正确,请重新输入！", vbOKOnly, "系统提示"
txtOldPass.Text = ""
txtNewPass.Text = ""
txtReplyPass.Text = ""
txtOldPass.SetFocus
Set rs = Nothing
Set cmd = Nothing
Exit Sub
End If
'加密密码
sPass = ""
sCliper = ""
If Trim$(txtNewPass.Text) <> "" Then
sPass = txtNewPass.Text
modCipher.Cipher "CoBeyond_Queue_Yixing", sPass, sCliper
End If
rs!ku_password = sCliper
rs.Update
End Select
End If
rs.Close
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set cmd = Nothing
'退出窗口
Unload Me
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "dlgPassword"
m_tagErrInfo.strErrFunc = "cmdOK_Click"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
Private Sub Form_Terminate()
On Error Resume Next
Set dlgPassword = Nothing
End Sub
Private Sub txtNewPass_GotFocus()
On Error Resume Next
txtNewPass.BackColor = &H80000018
End Sub
Private Sub txtNewPass_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回车键？
KeyAscii = 0 '0取消输入
SendKeys "{tab}"
End If
End Sub
Private Sub txtNewPass_LostFocus()
On Error Resume Next
txtNewPass.BackColor = &H80000005
End Sub
Private Sub txtOldPass_GotFocus()
On Error Resume Next
txtOldPass.BackColor = &H80000018
End Sub
Private Sub txtOldPass_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回车键？
KeyAscii = 0 '0取消输入
SendKeys "{tab}"
End If
End Sub
Private Sub txtOldPass_LostFocus()
On Error Resume Next
txtOldPass.BackColor = &H80000005
End Sub
Private Sub txtReplyPass_GotFocus()
On Error Resume Next
txtReplyPass.BackColor = &H80000018
End Sub
Private Sub txtReplyPass_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回车键？
KeyAscii = 0 '0取消输入
SendKeys "{tab}"
End If
End Sub
Private Sub txtReplyPass_LostFocus()
On Error Resume Next
txtReplyPass.BackColor = &H80000005
End Sub
'//////////////////////////////////////////////////////////////////////////////////////////
'/设定数据库名称
Public Property Let DateBase(ByVal vNewValue As String)
On Error Resume Next
m_sDateBase = vNewValue
End Property
'/设定数据编号
Public Property Let DateCode(ByVal vNewValue As Integer)
On Error Resume Next
m_iCode = vNewValue
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -