frmlogin.frm

自来水公司的一个管理系统

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "系统登录"
   ClientHeight    =   1770
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   5370
   ControlBox      =   0   'False
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1045.774
   ScaleMode       =   0  'User
   ScaleWidth      =   5042.139
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox txtName 
      Enabled         =   0   'False
      Height          =   270
      Left            =   3285
      TabIndex        =   7
      Top             =   165
      Width           =   1050
   End
   Begin VB.TextBox txtSerial 
      Height          =   270
      Left            =   2430
      TabIndex        =   0
      Top             =   165
      Width           =   885
   End
   Begin VB.TextBox txtPassWord 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   2430
      MousePointer    =   3  'I-Beam
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   570
      Width           =   1935
   End
   Begin VB.CommandButton cmdQD 
      Caption         =   "确  定"
      Enabled         =   0   'False
      Height          =   375
      Left            =   1200
      MouseIcon       =   "frmLogin.frx":0442
      MousePointer    =   99  'Custom
      Picture         =   "frmLogin.frx":074C
      TabIndex        =   2
      Top             =   1185
      Width           =   1215
   End
   Begin VB.CommandButton cmdQX 
      Caption         =   "取  消"
      Height          =   375
      Left            =   2910
      MouseIcon       =   "frmLogin.frx":0B8E
      MousePointer    =   99  'Custom
      Picture         =   "frmLogin.frx":0E98
      TabIndex        =   3
      Top             =   1185
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Height          =   135
      Left            =   75
      TabIndex        =   4
      Top             =   900
      Width           =   5145
   End
   Begin VB.Label Label1 
      Caption         =   "用户编号："
      Height          =   255
      Left            =   1560
      TabIndex        =   6
      Top             =   210
      Width           =   960
   End
   Begin VB.Label Label2 
      Caption         =   "密  码："
      Height          =   375
      Left            =   1560
      TabIndex        =   5
      Top             =   645
      Width           =   855
   End
   Begin VB.Image Image2 
      Height          =   525
      Left            =   360
      Picture         =   "frmLogin.frx":12DA
      Top             =   210
      Width           =   945
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strMaskString As String           '操作权限掩码
Dim adoRS As ADODB.Recordset    '业务员记录集

Private Sub cmdQD_Click()
    Dim strPostID As String     '岗位编码
    Dim adoMaskRS As ADODB.Recordset
    
     '赋全局变量
    gblnLoginSucceeded = True   '登录成功
    gstrCurOperatorID = Trim(Me.txtSerial.Text)
    gstrCurOperatorName = Trim(Me.txtName.Text)
    
    '得到该操作员的操作权限掩码
    strPostID = Trim(adoRS.Fields("PostID"))
    Set adoMaskRS = New ADODB.Recordset
    Set adoMaskRS.ActiveConnection = gConnect
    adoMaskRS.CursorLocation = adUseClient
    adoMaskRS.CursorType = adOpenForwardOnly
    adoMaskRS.LockType = adLockOptimistic
    adoMaskRS.Open "select Mask from Purview where PostID='" & strPostID & "'"
    
    If adoMaskRS.EOF And adoMaskRS.BOF Then
        strMaskString = ""
    Else
        strMaskString = Trim(adoMaskRS.Fields("Mask"))
    End If
    adoMaskRS.Close
    Set adoMaskRS = Nothing
    Unload Me
End Sub

Private Sub cmdQX_Click()
     '赋全局变量
    gblnLoginSucceeded = False  '登录失败
    gstrCurOperatorID = ""
    gstrCurOperatorName = ""
    strMaskString = ""
    Unload Me
End Sub

Private Sub Form_Load()
    '初始化记录集
    Set adoRS = New ADODB.Recordset
    Set adoRS.ActiveConnection = gConnect
    adoRS.CursorLocation = adUseClient
    adoRS.CursorType = adOpenForwardOnly
    adoRS.LockType = adLockOptimistic
    strMaskString = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoRS.Close
    Set adoRS = Nothing
    On Error GoTo 0
End Sub

Private Sub txtPassWord_GotFocus()
    Call AutoSelectText(txtPassWord)
End Sub

Private Sub txtPassWord_KeyPress(KeyAscii As Integer)
'    Call IfEnterKeyMoveNext(KeyAscii)
    If KeyAscii = 13 Then
        KeyAscii = 0
        SendKeys "{tab}"
    End If
End Sub

Private Sub txtPassWord_LostFocus()
    Dim blnOK As Boolean    '密码校验正确
    blnOK = False
    
    If Trim(Me.txtPassWord.Text) <> "" Then
        If Cipher(Trim(Me.txtPassWord.Text)) = Trim(adoRS.Fields("MM")) Then blnOK = True
    End If
    If blnOK Then
        Me.cmdQD.Enabled = True
        Me.cmdQD.SetFocus
    Else
        Me.cmdQD.Enabled = False
        Warning "密码错误!!!"
    End If
End Sub

Private Sub txtSerial_GotFocus()
    Call AutoSelectText(txtSerial)
End Sub

Private Sub txtSerial_KeyPress(KeyAscii As Integer)
'    Call IfEnterKeyMoveNext(KeyAscii)
    If KeyAscii = 13 Then
        KeyAscii = 0
        SendKeys "{tab}"
    End If
End Sub

Private Sub txtSerial_LostFocus()
    On Error Resume Next
    adoRS.Close
    On Error GoTo 0
    
    On Error GoTo OpenErr
    adoRS.Open "select EID,Name,PostID,MM from Employee where EID='" & Trim(Me.txtSerial.Text) & "'"
    On Error GoTo 0
    
    If adoRS.EOF And adoRS.BOF Then
        Me.txtName.Text = ""
        Me.txtPassWord.Text = ""
        Me.txtPassWord.Enabled = False
        Me.cmdQD.Enabled = False
        If Trim(Me.txtSerial.Text) <> "" Then Warning "未查询到该用户!!!"
    Else
        Me.txtName.Text = Trim(adoRS.Fields("Name"))
        Me.txtPassWord.Text = ""
        Me.txtPassWord.Enabled = True
        Me.cmdQD.Enabled = False
        Me.txtPassWord.SetFocus
    End If
    Exit Sub
    
    '-------错误处理---------
OpenErr:
    Warning "业务员表打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0
End Sub