⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmchpwd.frm

📁 通用书店管理系统
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frmchpwd 
   Appearance      =   0  'Flat
   BackColor       =   &H00C0E0FF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "更改密码"
   ClientHeight    =   3840
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4785
   Icon            =   "frmchpwd.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3840
   ScaleWidth      =   4785
   Begin VB.CommandButton Command1 
      Appearance      =   0  'Flat
      Height          =   495
      Left            =   1140
      Picture         =   "frmchpwd.frx":0442
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   3120
      Width           =   915
   End
   Begin VB.CommandButton Command2 
      Appearance      =   0  'Flat
      Cancel          =   -1  'True
      Height          =   495
      Left            =   2400
      Picture         =   "frmchpwd.frx":1926
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   3120
      Width           =   915
   End
   Begin VB.Frame Frame1 
      Appearance      =   0  'Flat
      BackColor       =   &H8000000A&
      ForeColor       =   &H80000008&
      Height          =   2835
      Left            =   360
      TabIndex        =   0
      Top             =   60
      Width           =   3495
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         Height          =   300
         IMEMode         =   3  'DISABLE
         Left            =   1140
         MaxLength       =   20
         PasswordChar    =   "*"
         TabIndex        =   1
         Top             =   600
         Width           =   1695
      End
      Begin VB.TextBox Text2 
         Appearance      =   0  'Flat
         Height          =   300
         IMEMode         =   3  'DISABLE
         Left            =   1140
         MaxLength       =   20
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   1260
         Width           =   1695
      End
      Begin VB.TextBox Text3 
         Appearance      =   0  'Flat
         Height          =   300
         IMEMode         =   3  'DISABLE
         Left            =   1140
         MaxLength       =   20
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   1980
         Width           =   1695
      End
      Begin VB.Label Label3 
         Caption         =   "确认:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   480
         TabIndex        =   8
         Top             =   2040
         Width           =   615
      End
      Begin VB.Label Label2 
         Caption         =   "新密码:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   360
         TabIndex        =   7
         Top             =   1320
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "旧密码:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   360
         TabIndex        =   6
         Top             =   600
         Width           =   855
      End
   End
End
Attribute VB_Name = "frmchpwd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public blnmodeok As Boolean
Public blnforcechg As Boolean
'Public ChgPwdOK As Boolean ' lzw remark 将其移到全局变量

Private Sub Command1_Click()
    Dim strql As String, strtmp As String
    Dim rs As New ADODB.Recordset
    'strql = "select chrpassword from tau_users where chrsid='" & gchrsid & "' and chrusername='" & gchruid & "'"
    
    ' lzw remark,不要chrsid作条件:
    'strql = "select chrpassword from tau_users where chrsid='rs' and chrusername='" & CurrentOperator & "'"
    strql = "select chrpassword from tau_users where  chrusername='" & strUserName & "'"
    
    rs.Open strql, cN, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
        strtmp = Mid(rs.Fields(0), 1, 2)
    Else
        MsgBox "数据库有误,找不到用户名。", vbExclamation
        Unload Me
        Exit Sub
    End If
    If Text1.Text <> strUserPasswd Then
        MsgBox "原密码有误!", vbCritical
        Text1.SetFocus
        SendKeys "{Home}+{End}"
        Exit Sub
    End If
    If Not (checkinput(Text1.Text) And checkinput(Text2.Text) And checkinput(Text3.Text)) Then
        MsgBox "输入不正确!", vbCritical
        Text2.SetFocus
        SendKeys "{Home}+{End}"
        Exit Sub
    End If
    If Text2.Text = Text1.Text Then
        MsgBox "新密码不能与旧密码相同,请重输。", vbExclamation, "警告"
        Text2.SetFocus
        SendKeys "{Home}+{End}"
        Exit Sub
    End If
    If Text2.Text <> Text3.Text Then
        MsgBox "密码不能确认,请重输。", vbCritical, "错误"
       ' Text2.Text = ""
       ' Text3.Text = ""
        Text2.SetFocus
        SendKeys "{Home}+{End}"
        Exit Sub
    End If
    If Len(Trim(Text2.Text)) < 6 Then
        MsgBox "密码至少需要6位!", vbCritical, "错误"
        Text2.SetFocus
        SendKeys "{Home}+{End}"
        Exit Sub
    End If
    If blnforcechg Then
        #If Access数据库 Then
            strql = "update tau_users set lasttimepwdchg='" & Format(Now(), "yyyy-mm-dd HH:MM:SS") & "',chrpassword='+." & Encrypt(Trim(strUserName) + Trim(Text2.Text)) & "' where  chrusername='" & strUserName & "'"
        #Else
            strql = "update tau_users set lasttimepwdchg=convert(varchar,getdate(),120),chrpassword='+." & Encrypt(Trim(strUserName) + Trim(Text2.Text)) & "' where chrusername='" & strUserName & "'"
        #End If
    Else
        #If Access数据库 Then
            strql = "update tau_users set lasttimepwdchg='" & Format(Now(), "yyyy-mm-dd HH:MM:SS") & "',chrpassword='" & Trim(strtmp & Encrypt(Trim(strUserName) + Trim(Text2.Text))) & "' where  chrusername='" & strUserName & "'"
        #Else
            strql = "update tau_users set lasttimepwdchg=convert(varchar,getdate(),120),chrpassword='" & Trim(strtmp & Encrypt(Trim(strUserName) + Trim(Text2.Text))) & "' where  chrusername='" & strUserName & "'"
        #End If
    End If
    cN.Execute strql, , 1
    
    ' remark:
    'objServer.UpShow strLocalName & "," & DatabaseName & "," & CurrentSetname & "," & CurrentOperator & " 修改密码成功!"
    
    
    blnmodeok = True
    'ChgPwdOK = True
    blnChangPwdOK = True
    MsgBox "修改密码成功。", vbInformation, "提示"
    
'    Passwd = Trim(Text2.Text)  remark
'    CurrentPassword = Passwd
    
    strUserPasswd = Trim(Text2.Text)

    Unload Me
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub


Private Sub Form_Load()
   Me.Top = 1500
   Me.Left = 4000
   Me.Height = 4215
   Me.Width = 4320
   Me.Caption = Me.Caption & "  当前操作员:" & strUserName
    blnmodeok = False
    'ChgPwdOK = False
    blnChangPwdOK = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    blnforcechg = False
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii)
End Sub

Private Function checkinput(strinput As String, Optional blnnone As Boolean = True) As Boolean
    If InStr(1, strinput, "=") > 0 Then Exit Function
    If InStr(1, strinput, " ") > 0 Then Exit Function
    If InStr(1, strinput, ".") > 0 Then Exit Function
    If InStr(1, strinput, ";") > 0 Then Exit Function
    If blnnone Then
        If Len(strinput) = 0 Then Exit Function
    End If
    checkinput = True
End Function
'回车后自动换行
Public Sub EnterToTab(KeyAscii As Integer)
    KeyAscii = 0
    SendKeys "{TAB}"
    SendKeys "{Home}+{End}"
End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -