frmlogin.frm

本人用VB 6.0和ACCESS编写的水费管理系统

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录"
   ClientHeight    =   1530
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   3750
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   903.974
   ScaleMode       =   0  'User
   ScaleWidth      =   3521.047
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox txtCombo 
      Height          =   300
      ItemData        =   "frmLogin.frx":0442
      Left            =   1290
      List            =   "frmLogin.frx":0444
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   120
      Width           =   2295
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   390
      Left            =   495
      TabIndex        =   3
      Top             =   1020
      Width           =   1140
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   390
      Left            =   2100
      TabIndex        =   4
      Top             =   1020
      Width           =   1140
   End
   Begin VB.TextBox txtPassword 
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   1290
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   525
      Width           =   2295
   End
   Begin VB.Label lblLabels 
      Caption         =   "用户名称(&U):"
      Height          =   270
      Index           =   0
      Left            =   105
      TabIndex        =   0
      Top             =   150
      Width           =   1080
   End
   Begin VB.Label lblLabels 
      Caption         =   "密码(&P):"
      Height          =   270
      Index           =   1
      Left            =   105
      TabIndex        =   1
      Top             =   540
      Width           =   1080
   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 LoginSucceeded As Boolean
Dim ws As Workspace, db As Database, rs As Recordset
Dim ReadNum() As Integer, ReadNameNum() As Integer
Dim ReadName1() As String, ReadName2() As String
Dim ReadPassword() As String

Private Sub cmdCancel_Click()
    '设置全局变量为 false
    '不提示失败的登录
    LoginSucceeded = False
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    '检查输入框是否为空
    If txtCombo = "" Then
        MsgBox "没有选定人员,请选定人员！", vbExclamation + vbOKOnly
        Exit Sub
    End If
    '检查正确的密码
    Dim ReadIndex As Integer
    ReadIndex = txtCombo.ListIndex + 1
    If txtPassword = ReadPassword(ReadIndex) Then
        '将代码放在这里传递
        '成功到 calling 函数
        '设置全局变量时最容易的
        OperatorNum = ReadNum(ReadIndex)
        OperatorNameNum = ReadNameNum(ReadIndex)
        OperatorName1 = ReadName1(ReadIndex)
        OperatorName2 = ReadName2(ReadIndex)
        LoginSucceeded = True
        Me.Hide
    Else
        MsgBox "无效的密码，请重试!", , "登录"
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
    End If
End Sub

Private Sub Form_Load()
    '打开权限表
    Dim strAppName As String
    strAppName = App.Path + "\权限表.mdb"
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(strAppName, False, True)
    Set rs = db.OpenRecordset("权限表")
    '向组合框中添加人员名
    Dim i, ReadCount As Integer
    ReadCount = rs.RecordCount
    ReDim Preserve ReadNum(ReadCount), ReadNameNum(ReadCount)
    ReDim Preserve ReadName1(ReadCount), ReadName2(ReadCount)
    ReDim Preserve ReadPassword(ReadCount)
    rs.MoveFirst
    For i = 1 To ReadCount
        ReadNum(i) = rs.Fields("编号")
        ReadNameNum(i) = rs.Fields("人员代号")
        ReadName1(i) = rs.Fields("人员名")
        ReadName2(i) = rs.Fields("姓名")
        If rs.Fields("密码") <> "" Then
            ReadPassword(i) = rs.Fields("密码")
        Else
            ReadPassword(i) = ""
        End If
        txtCombo.AddItem ReadName2(i)
        rs.MoveNext
    Next
    rs.Close
    db.Close
    ws.Close
    Set rs = Nothing
    Set db = Nothing
    Set ws = Nothing
End Sub