rl_mod_password.frm

图书管理软件,基本功能已具备

VERSION 5.00
Begin VB.Form RL_Mod_Password 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "修改密码"
   ClientHeight    =   2805
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3675
   Icon            =   "RL_Mod_Password.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2805
   ScaleWidth      =   3675
   Begin VB.CommandButton cmd_Close 
      Caption         =   "取消(&C)"
      Height          =   345
      Left            =   2460
      TabIndex        =   10
      Top             =   2340
      Width           =   1095
   End
   Begin VB.CommandButton cmd_OK 
      Caption         =   "确定(&O)"
      Height          =   345
      Left            =   1170
      TabIndex        =   9
      Top             =   2340
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Height          =   2175
      Left            =   75
      TabIndex        =   0
      Top             =   0
      Width           =   3480
      Begin VB.TextBox txt_Affirmation 
         Height          =   300
         Left            =   1260
         TabIndex        =   8
         Text            =   "Text1"
         Top             =   1665
         Width           =   2000
      End
      Begin VB.TextBox txt_NewPassword 
         Height          =   300
         Left            =   1260
         TabIndex        =   6
         Text            =   "Text1"
         Top             =   1185
         Width           =   2000
      End
      Begin VB.TextBox txt_OldPassword 
         Height          =   300
         Left            =   1260
         TabIndex        =   4
         Text            =   "Text1"
         Top             =   720
         Width           =   2000
      End
      Begin VB.TextBox txt_UserName 
         Enabled         =   0   'False
         Height          =   300
         Left            =   1260
         TabIndex        =   2
         Text            =   "Text1"
         Top             =   240
         Width           =   2000
      End
      Begin VB.Label Label4 
         Caption         =   "确  认(&A)"
         Height          =   255
         Left            =   150
         TabIndex        =   7
         Top             =   1695
         Width           =   1000
      End
      Begin VB.Label Label3 
         Caption         =   "新密码(&N)"
         Height          =   255
         Left            =   150
         TabIndex        =   5
         Top             =   1215
         Width           =   1000
      End
      Begin VB.Label Label2 
         Caption         =   "旧密码(&N)"
         Height          =   255
         Left            =   150
         TabIndex        =   3
         Top             =   750
         Width           =   1000
      End
      Begin VB.Label Label1 
         Caption         =   "用户名"
         Height          =   255
         Left            =   150
         TabIndex        =   1
         Top             =   270
         Width           =   735
      End
   End
End
Attribute VB_Name = "RL_Mod_Password"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************
'*公司名：华夏学院晨光网络公司
'*系统名：红杉图书信息管理系统
'*程序名：修改密码
'*程序ID：RL_Mod_Password
'*版本：1.0.0
'*最后修改时间：2005/4/7
'*修改人：cuitianlong
'*
'*-------------------------------------------------------------
'*  [年月日]        [制造者]
'*-------------------------------------------------------------
'*  2005/4/7        cuitianlong
'*
'***************************************************************
Option Explicit

Dim rc         As New ADODB.Recordset  '定义记录集
Dim C_UserName As String               '登陆的用户名

'***************************************************************
'*  窗体加载
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_Load()
    On Error GoTo Form_Load
    
    '--- 窗体居中设置
    Call Cmn_Form_Center(Me)
    '--- 设置各个控件初始值
    Call Item_Clear
    
    Exit Sub
Form_Load:
    MsgBox "Form_Load()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体退出 [QueryUnload]
'*
'*  [参数]
'*      1：系统参数
'*      2：系统参数
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error GoTo Form_QueryUnload
    
    Dim YesNo As Integer
        
    '---执行前确认
    YesNo = MsgBox("真的要退出修改密码吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        Unload Me
    Else
        Cancel = 1
    End If
    
    Exit Sub
Form_QueryUnload:
    MsgBox "Form_QueryUnload()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体卸载 [Unload]
'*
'*  [参数]
'*      1：系统参数
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo Form_Unload
    
    Call Cmn_Ado_DisRecordset(rc) '关闭记录集
    
    Exit Sub
Form_Unload:
    MsgBox "Form_Unload()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体项目清空
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub Item_Clear()
    On Error GoTo Item_Clear
    
    txt_UserName.text = C_LoginName
    txt_OldPassword.text = ""
    txt_NewPassword.text = ""
    txt_Affirmation.text = ""
    
    Exit Sub
Item_Clear:
    MsgBox "Item_Clear()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  cmd_Close_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Close_Click()
    On Error Resume Next
    
    Unload Me
    
End Sub

'***************************************************************
'*  cmd_OK_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_OK_Click()
    On Error GoTo cmd_OK_Click
    
    '---项目检测
    If Item_Check = False Then
        Exit Sub
    End If
    
    '---修改语句
    Call Exe_Mod_Password
    
    '---项目清空
    Call Item_Clear
    
    Exit Sub
cmd_OK_Click:
    MsgBox "cmd_OK_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  Exe_Mod_Password
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'***************************************************************
Private Function Exe_Mod_Password() As Boolean
    On Error GoTo Exe_Mod_Password
    
    Dim S_UserName    As String
    Dim S_OldPassword As String
    Dim S_NewPassword As String
    Dim S_Affirmation As String
    Dim S_SQL         As String
    
    S_UserName = C_LoginName
    S_OldPassword = Trim(txt_OldPassword.text)
    S_NewPassword = Trim(txt_NewPassword.text)
    S_Affirmation = Trim(txt_Affirmation.text)
    
    '---查看旧密码是否正确
    S_SQL = ""
    S_SQL = S_SQL & " SELECT UserName"
    S_SQL = S_SQL & " FROM T_User"
    S_SQL = S_SQL & " WHERE Username='" & S_UserName & "'"
    S_SQL = S_SQL & " AND"
    S_SQL = S_SQL & " UserPassword='" & S_OldPassword & "'"
    
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    '---旧密码错误
    If rc("Username") <> S_UserName Then
        MsgBox "您输入的密码错误", vbInformation, "提示"
        txt_OldPassword.SetFocus
        Exit Function
    End If
    
    '---修改密码
    S_SQL = ""
    S_SQL = S_SQL & " UPDATE T_User SET"
    S_SQL = S_SQL & " UserPassword='" & S_NewPassword & "'"
    S_SQL = S_SQL & " WHERE UserName='" & S_UserName & "'"
    S_SQL = S_SQL & " AND"
    S_SQL = S_SQL & " UserPassword='" & S_OldPassword & "'"

    Dim YesNo As Integer
    
    '---执行SQL语句前确认
    YesNo = MsgBox("确定修改数据吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        '---执行数据插入语句
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Exit Function
    End If
    Exit Function
Exe_Mod_Password:
    MsgBox "Exe_Mod_Password()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  项目检测
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'****************************************************************
Private Function Item_Check() As Boolean
    On Error GoTo Item_Check

    '---返回值初始设置
    Item_Check = False
    
    
    Dim S_Check_UserName    As String
    Dim S_Check_OldPassword As String
    Dim S_Check_NewPassword As String
    Dim S_Check_Affirmation As String
    
    '---设置读者编号长度检测
    S_Check_OldPassword = Check_Txt(txt_OldPassword, 0, 10, "旧密码", "提示")
    '---设置读者姓名长度检测
    S_Check_NewPassword = Check_Txt(txt_NewPassword, 0, 10, "新密码", "提示")
    '---设置确认密码长度检测
    S_Check_Affirmation = Check_Txt(txt_Affirmation, 0, 10, "确认密码", "提示")
    '[txt_ReaderID]
    If (False = S_Check_OldPassword) Then
        txt_OldPassword.SetFocus
        Exit Function
    End If
    '[txt_ReaderName]
    If (False = S_Check_NewPassword) Then
        txt_NewPassword.SetFocus
        Exit Function
    End If
    If (False = S_Check_Affirmation) Then
        txt_Affirmation.SetFocus
        Exit Function
    End If
    
    If Trim(txt_Affirmation.text) <> Trim(txt_NewPassword.text) Then
        MsgBox "确认密码与新密码内容不一致", vbInformation, "提示"
        txt_Affirmation.SetFocus
        Exit Function
    End If
    
    '---返回值正确设置
    Item_Check = True

    Exit Function
Item_Check:
    MsgBox "Item_Check()---出错", vbCritical, "错误"
End Function

'***************************************************************
'*  txt_Affirmation获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_Affirmation_GotFocus()
    On Error GoTo txt_Affirmation_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_Affirmation)
    
    Exit Sub
txt_Affirmation_GotFocus:
    MsgBox "txt_Affirmation_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_Affirmation失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_Affirmation_LostFocus()
    On Error GoTo txt_Affirmation_LostFocus
    
    Call Cmn_Txt_LostFocus(txt_Affirmation)
    
    Exit Sub
txt_Affirmation_LostFocus:
    MsgBox "txt_Affirmation_LostFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_OldPassword获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_OldPassword_GotFocus()
    On Error GoTo txt_OldPassword_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_OldPassword)
    
    Exit Sub
txt_OldPassword_GotFocus:
    MsgBox "txt_OldPassword_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_OldPassword失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_OldPassword_LostFocus()
    On Error GoTo txt_OldPassword_LostFocus
    
    Call Cmn_Txt_LostFocus(txt_OldPassword)
    
    Exit Sub
txt_OldPassword_LostFocus:
    MsgBox "txt_OldPassword_LostFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_NewPassword获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_NewPassword_GotFocus()
    On Error GoTo txt_NewPassword_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_NewPassword)
    
    Exit Sub
txt_NewPassword_GotFocus:
    MsgBox "txt_NewPassword_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_NewPassword失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_NewPassword_LostFocus()
    On Error GoTo txt_NewPassword_LostFocus
    
    Call Cmn_Txt_LostFocus(txt_NewPassword)
    
    Exit Sub
txt_NewPassword_LostFocus:
    MsgBox "txt_NewPassword_LostFocus()---出错", vbCritical, "错误"
End Sub