frmsyslogin.frm

来自「通用书店管理系统」· FRM 代码 · 共 228 行

FRM
228
字号
VERSION 5.00
Begin VB.Form frmSysLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录"
   ClientHeight    =   2010
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   4380
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   1187.576
   ScaleMode       =   0  'User
   ScaleWidth      =   4112.583
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdDB 
      Caption         =   "选项"
      Height          =   339
      Left            =   2880
      TabIndex        =   6
      Top             =   1440
      Width           =   852
   End
   Begin VB.TextBox txtUserName 
      Height          =   270
      Left            =   1320
      MaxLength       =   10
      TabIndex        =   0
      Top             =   240
      Width           =   2535
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   339
      Left            =   480
      TabIndex        =   2
      Top             =   1440
      Width           =   852
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   339
      Left            =   1680
      TabIndex        =   3
      Top             =   1440
      Width           =   855
   End
   Begin VB.TextBox txtPassword 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1320
      MaxLength       =   20
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   840
      Width           =   2535
   End
   Begin VB.Label lblLabels 
      Caption         =   "用户名(&U):"
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   4
      Top             =   285
      Width           =   1080
   End
   Begin VB.Label lblLabels 
      Caption         =   "密码(&P):"
      Height          =   270
      Index           =   1
      Left            =   360
      TabIndex        =   5
      Top             =   885
      Width           =   1080
   End
End
Attribute VB_Name = "frmSysLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private i As Integer
Public blnLoginOK As Boolean


Private Sub cmdCancel_Click()
'    If blnLogin Then
'        blnLogin = False
'    End If
    Me.Hide                 ' 隐藏窗口
End Sub

Private Sub cmdDB_Click()
'    If txtPassword.Text = EnCrypt_conPWD(Trim(txtUserName.Text) & Format(Date, "yyyy-MM-dd")) Then
        frmDBconfirm.Show vbModal
'    Else
'        MsgBox "要修改数据库连接配置,请输入正确的用户名与密码...", vbInformation
'    End If
End Sub

Private Sub cmdOK_Click()    '检查正确的密码
    Dim strPWD As String
    Dim rs As ADODB.Recordset  ' lzw 用于返回用户姓名
    On Error GoTo Err
    
'    If ghcon.State = adStateClosed Then
'        Call setDBConnect(ghcon)
'    End If
  

   
    If Len(txtUserName.Text) = 0 Then
        MsgBox "用户名为空,请输入.."
        txtUserName.SetFocus
        SendKeys "{Home}+{End}"
        Exit Sub
    End If
    If Len(txtPassword.Text) = 0 Then
'        MsgBox "密码为空,请输入.."
        txtPassword.SetFocus
'        SendKeys "{Home}+{End}"
        Exit Sub
    End If
    
   'strSql = "select chrCompanyName from Company where chrCompanyName='阳光书社' or chrCompanyName='南郑县教育书店'"  ' lzw 2002-06-25
'   strSql = "select chrCompanyName from Company where chrCompanyName='试用书店'"
   strSql = "select chrCompanyName from Company"
   Set rs = cN.Execute(strSql, , 1)
   If rs.EOF Then
        MsgBox "您是非法用户,拒绝登录!", vbCritical + vbOKOnly
        Me.Hide
        Exit Sub
   Else
        strCompanyName = rs("chrCompanyName")
   End If
   Set rs = Nothing
   
    strPWD = txtPassword.Text
    'If checkuser(ghcon, txtUserName.Text, strpwd) Then
    If checkuser(txtUserName, strPWD, "书店管理系统") Then
        'If Mid(strpwd, 1, 1) = "*" And strLoginUserID <> "admin" Then  lzw remark
        If Mid(strPWD, 1, 1) = "*" And txtUserName <> "admin" Then
'            blnchgpwd = True    '更改密码
            MsgBox "您必须更改密码后才能登录系统。", vbInformation + vbOKOnly, "成本核算系统"
            'frmChangePWD.Show vbModal  lzw remark
            frmchpwd.Show vbModal
            
            ' lzw 暂时不要下段
'            If Not blnchgpwd Then
''                MsgBox "第一次登录系统,请先修改您的密码...", , "密码修改"
'                Me.Hide
'                blnLogin = False
'                Exit Sub
'            End If
        End If
        
        ' lzw 暂时不要下段
'        If Mid(strpwd, 1, 1) = "#" Or Mid(strpwd, 1, 1) = "-" Then
'            MsgBox "您的帐号已被禁止,请与管理员联系...", vbExclamation
'            Me.Hide     ' lzw
'            blnLogin = False
'            Exit Sub
'        End If
        'blnLogin = True  remark
        
        ' lzw 增加返回用户名操作
        strSql = "select chrtruename from tau_users where chrusername='" & Trim(txtUserName.Text) & "'"
        Set rs = cN.Execute(strSql, , 1)
        If Not rs.EOF Then
            strUserTrueName = rs("chrtruename")
        Else
            strUserTrueName = ""
        End If
        Set rs = Nothing
        
        
        blnLoginOK = True
        Me.Hide
        Exit Sub
    Else
'        blnLogin = False  remark
        i = i + 1
        If i > 3 Then
            MsgBox "您是非法用户,被拒绝登录!", vbCritical + vbOKOnly
            Me.Hide
            Exit Sub
        Else
            MsgBox "用户代码和密码无效,请重试!", , "登录"
            txtPassword.SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
    End If
        
  
'        blnLoginOK = True       ' 登录成功
'        Me.Hide                 ' 隐藏窗口
        Exit Sub
Err:
    MsgBox "程序出错:" & Err.Description & "请与系统管理员联系...", vbInformation, "出错信息"
'    Call KillForm("frmSplash")
End Sub



Private Sub Form_Load()
    blnLoginOK = False
    i = 0
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub


Private Sub txtworknum_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub

⌨️ 快捷键说明

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