b_login.frm

基于VB开

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form B_Login 
   BackColor       =   &H00FFC0C0&
   Caption         =   "  登 录"
   ClientHeight    =   2370
   ClientLeft      =   3855
   ClientTop       =   2640
   ClientWidth     =   4185
   LinkTopic       =   "Form1"
   Moveable        =   0   'False
   ScaleHeight     =   2370
   ScaleWidth      =   4185
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   240
      Top             =   240
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command2 
      Caption         =   "放 弃"
      Height          =   320
      Left            =   2280
      TabIndex        =   3
      Top             =   1560
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确 定"
      Enabled         =   0   'False
      Height          =   320
      Left            =   960
      TabIndex        =   2
      Top             =   1560
      Width           =   975
   End
   Begin VB.TextBox Text2 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   2040
      PasswordChar    =   "*"
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   960
      Width           =   855
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   2040
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   240
      Width           =   855
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFC0C0&
      Caption         =   "密    码："
      Height          =   255
      Left            =   840
      TabIndex        =   5
      Top             =   960
      Width           =   1095
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "用户名称："
      Height          =   255
      Left            =   840
      TabIndex        =   4
      Top             =   300
      Width           =   1095
   End
End
Attribute VB_Name = "B_Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'     ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
'     ┃         B_Login      登录 检验用户名及密码             ┃
'     ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛

Option Explicit

    Dim bytLgn As Byte                         ' 全程变量  StrUjb StrKls
    Dim blnLok As Boolean, blnTc As Boolean
'

Private Sub Form_Load()
   
    strT0 = "T_tm"
    
    If myF_ChekTRec(strT0) < 1 Then                            ' 检查 T_tm 记录
       MsgBox "  Not Find T_tm ...  ", 48, "  !!"
       blnTc = True: Exit Sub
    End If
    
    Set MyRs0 = New Recordset
    StrSQL = "SELECT * FROM " & strT0 & " WHERE Dm like 'Kl%' ORDER BY Dm"
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
           N0 = MyRs0.RecordCount
        If MyRs0.RecordCount > 0 Then
           MyRs0.MoveLast
           N0 = MyRs0.RecordCount
        Else
           MsgBox "  Not Find Datas ...  ", 48, "  Error"
           blnTc = True: Exit Sub
        End If
    
    bytLgn = 3                                                 ' 限制次数
    Text1.Text = ""
    Text2.Text = ""
        
    i = A_Start.Top + (A_Start.Height - Me.Height) / 2
    Me.Top = 6 * i / 9
    i = A_Start.imgLogo.Left + A_Start.imgLogo.Width
    Me.Left = A_Start.Left + A_Start.Frame1.Left + i + (A_Start.Frame1.Width - i - Me.Width) / 2
       
End Sub

Private Sub Form_Activate()
    If blnTc Then Unload Me
    Text1.SetFocus
End Sub

Private Sub Text1_Change()                                     ' 检查用户名
    StrUse = Trim(Text1.Text)
    If myF_Len(StrUse) > 6 Then
       MsgBox "  用户名最大长度为六个英文字符位，请修改 ... ", 48, "  请注意"
       Text1.Text = Left(StrUse, 6)
       Text1.SetFocus                                          ' 重新输入
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)                ' 检验
    If KeyAscii = 13 Then Call Text1_LostFocus
End Sub

Private Sub Text1_LostFocus()
    StrUse = Trim(Text1.Text)
       If StrUse = "" Then
          Command2.SetFocus                                    ' Quit
       Else
          If F_HcUse Then                                      ' PtxtUserName
             Text2.SetFocus
          Else                                                 ' 用户名未通过
             If bytLgn = 0 Then
                MsgBox "  很抱歉，用户名不符 ...  ", 48, "  登录错误 !!!"
                StrUjb = "3"
                Unload Me
             End If
          End If
       End If
End Sub

Function F_HcUse() As Boolean                                  ' 核对用户名
    StrUse = Trim(Text1.Text)
       blnLok = False
       MyRs0.MoveFirst
       Do While Not MyRs0.EOF
          If Trim(MyRs0![Mc]) = StrUse Then
             blnLok = True: Exit Do
          End If
          MyRs0.MoveNext
       Loop
    If Not blnLok Then
       F_HcUse = False                                         ' 用户名不符
       bytLgn = bytLgn - 1
       If bytLgn > 0 Then
          MsgBox "  请再输入一次用户名 ... ", 48, "  登录错误 " & IIf(bytLgn = 1, "!!", "!")
          Text1.Text = ""
          Text1.SetFocus
       End If
    Else
       F_HcUse = True
       bytLgn = 3
    End If
End Function

Private Sub Text2_Change()
    StrKls = Trim(Text2.Text)
    If StrKls = "" Then Exit Sub
    If myF_Len(StrUse) > 6 Then
       MsgBox "  密码最大长度为六个英文字符位，请修改 ... ", 48, "  请注意"
       Text2.Text = Left(StrKls, 6)
       Text2.SetFocus                                          ' 重新输入
    End If
    If StrKls = Trim(MyRs0![Jc]) Then Command1.Enabled = True
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)                ' 检验
    If KeyAscii = 13 Then Call Text2_LostFocus
End Sub

Private Sub Text2_LostFocus()
    StrKls = Trim(Text2.Text)
       If StrKls = "" Then
          Command2.SetFocus                                    ' Re Input
       Else
          If F_HcKls Then                                      ' txtPassword
             Command1.SetFocus
          Else                                                 ' 密码未通过
             If bytLgn = 0 Then
                MsgBox "  很抱歉，密码不符 ...  ", 48, "  登录错误 !!!"
                StrUjb = "3"
                Unload Me
             End If
          End If
       End If
End Sub

Function F_HcKls() As Boolean                                  ' 核对密码
    StrKls = Trim(Text2.Text)
       If StrKls = Trim(MyRs0![Jc]) Then
          F_HcKls = True
          StrUjb = MyRs0![Bz]                                  ' 取出级别
          Command1.Enabled = True
       Else
          F_HcKls = False                                      ' 口令不符
          bytLgn = bytLgn - 1
          If bytLgn > 0 Then
             MsgBox "  请再输入一次密码 ... ", 48, "  登录错误 " & IIf(bytLgn = 1, "!!", "!")
             Text2.Text = ""
             Text2.SetFocus
          End If
       End If
End Function

Private Sub Command1_KeyPress(KeyAscii As Integer)             ' cmdOK
    If KeyAscii = 13 Then Call Command1_Click
End Sub

Private Sub Command1_Click()                                   ' 确认处理
    StrDms = MyRs0![dm]
    StrUjb = MyRs0![Bz]                                        ' 取出级别
    StrUse = Trim(Text1.Text)
    StrKls = Trim(Text2.Text)
    MyRs0.Close
    Unload Me
End Sub

Private Sub Command2_Click()                                   ' cmdCancel
    StrUjb = "3"
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    'If N0 > 0 Then MyRs0.Close                                ' ?
    Select Case StrUjb
           Case "1"
                Form01.Show                                    ' 启动管理员菜单
           Case "2"
                Form02.Show                                    ' 启动操作员菜单
           Case "3"
                Form03.Show                                    ' 启动浏览菜单
    End Select

End Sub