frmpassord.frm

人事资源管理系统

VERSION 5.00
Begin VB.Form frmPassord 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "修改密码"
   ClientHeight    =   2730
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   4320
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1612.974
   ScaleMode       =   0  'User
   ScaleWidth      =   4056.246
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox txtNewPass 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   1680
      PasswordChar    =   "*"
      TabIndex        =   6
      Top             =   960
      Width           =   2295
   End
   Begin VB.TextBox txtOldPass 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1680
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   360
      Width           =   2325
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   390
      Left            =   600
      TabIndex        =   4
      Top             =   2160
      Width           =   1140
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   390
      Left            =   2400
      TabIndex        =   5
      Top             =   2160
      Width           =   1140
   End
   Begin VB.TextBox txtPasswordSure 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1680
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   1560
      Width           =   2325
   End
   Begin VB.Label Label1 
      Caption         =   "请输入新密码"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   1080
      Width           =   1335
   End
   Begin VB.Label lblLabels 
      Caption         =   "请输入原密码"
      Height          =   270
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1440
   End
   Begin VB.Label lblLabels 
      Caption         =   "确认密码"
      Height          =   270
      Index           =   1
      Left            =   480
      TabIndex        =   2
      Top             =   1680
      Width           =   1080
   End
End
Attribute VB_Name = "frmPassord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ******************************************************************************
'窗体公共变量定义
' ******************************************************************************
Option Explicit
Dim txtSQL As String    'SQL语句
Dim rstPass As ADODB.Recordset    '用户信息数据集
Dim results As Boolean    'ExcuteSQL函数执行结果
Private Sub cmdCancel_Click()
    Me.Hide
End Sub
Private Sub cmdOK_Click()
Dim strPass As String '检索该用户输入的原密码是否正确
txtSQL = "select UserPassword from tbUser where UserId='" + gUserName + "'"
results = ExecuteSQL(txtSQL, rstPass, False)
strPass = rstPass.Fields(0)
If StrComp(Trim(strPass), Trim(txtOldPass.Text)) <> 0 Then
    MsgBox " 原密码不正确！", vbOKOnly + vbExclamation, "警告"
    Me.txtOldPass.SetFocus
    txtOldPass.BackColor = BLUE
    Exit Sub
Else
'检验新密码不能为空
    If txtIsNull(txtNewPass) Then
        MsgBox "请输入新密码，密码不能为空！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
        If IsOverStringLen(txtNewPass.Text, 8) Then
            MsgBox "密码不能超过8位！", vbOKOnly + vbExclamation, "警告"
            txtNewPass.SetFocus
            txtNewPass.BackColor = BLUE
            Exit Sub
        End If
    End If
    '密码必须确认
    If txtIsNull(txtPasswordSure) Then
        MsgBox "请确认新密码！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    End If
    '检验两次输入的新密码是否
    If StrComp(Trim(txtPasswordSure.Text), Trim(txtNewPass.Text)) <> 0 Then
        MsgBox "两次输入密码不一致！", vbOKOnly + vbExclamation, "警告"
        txtPasswordSure.SetFocus
        txtPasswordSure.BackColor = BLUE
        Exit Sub
    End If
    '更新数据库
    txtSQL = "update tbUser set UserPassword = '" + Trim(txtNewPass.Text)
    txtSQL = txtSQL + "' where UserId='" + gUserName + "'"
    results = ExecuteSQL(txtSQL, rstPass, True)
    MsgBox " 密码修改成功！", vbOKOnly + vbExclamation, "警告"
    Unload Me
End If
End Sub

Private Sub txtNewPass_Change()
txtNewPass.BackColor = WHITE
End Sub
Private Sub txtOldPass_Change()
txtOldPass.BackColor = WHITE
End Sub
Private Sub txtPasswordSure_Change()
txtPasswordSure.BackColor = WHITE
End Sub