form1.frm

petrostation + sysytem

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "请登录"
   ClientHeight    =   3990
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6555
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "Form1.frx":29C12
   ScaleHeight     =   3990
   ScaleWidth      =   6555
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   495
      Left            =   3840
      TabIndex        =   5
      Top             =   3000
      Width           =   1575
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   495
      Left            =   1320
      TabIndex        =   4
      Top             =   3000
      Width           =   1575
   End
   Begin VB.TextBox txtPWD 
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   3480
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   2040
      Width           =   2055
   End
   Begin VB.ComboBox cmbUserName 
      Height          =   300
      Left            =   3480
      TabIndex        =   2
      Text            =   "cmbUserName"
      Top             =   1200
      Width           =   2055
   End
   Begin VB.Image Image1 
      Height          =   1080
      Left            =   600
      Picture         =   "Form1.frx":387AD
      Top             =   1200
      Width           =   1080
   End
   Begin VB.Label labPWD 
      BackStyle       =   0  'Transparent
      Caption         =   "密  码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   2040
      Width           =   1455
   End
   Begin VB.Label labUsername 
      BackStyle       =   0  'Transparent
      Caption         =   "用户名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1920
      TabIndex        =   0
      Top             =   1200
      Width           =   1455
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim connstring As String
Dim num As Integer                ' 用于保存密码输入错误次数
Private Sub CmdCancel_Click()
    Unload frmLogin      '卸载登录窗口
End Sub

Private Sub cmdOK_Click()
    If Trim(cmbUserName.Text) = "" Then           '首先要求用户名不能为空
       MsgBox "用户名不能为空！", vbOKOnly + vbExclamation, "警告！"
       cmbUserName.SetFocus             '将焦点转移到用户名组合框中
       Exit Sub
    End If
    connstring = "Provider=SQLOLEDB.1;Password=ecc;Persist Security Info=True;User ID=sa;" _
    & "Initial Catalog=PetrolStation System;Server=(local)"
    If conn.State <> 1 Then              '如果数据库没有打开则打开数据库
        conn.Open (connstring)
    End If
    Set rs = conn.Execute("select * from PS_Users where 用户='" & Trim(cmbUserName.Text) & "'")
    ' 在users数据表中检索用户字段值为用户输入的用户名的记录，将结果存放在rs记录集中
    If rs.EOF Then                '  如果记录为空则说明不存在此条记录，也说明用户名错误
       MsgBox " 没有该用户！" & vbCrLf & " 请重新输入！", vbOKOnly + vbExclamation, "提示"
       cmbUserName.SetFocus
       Exit Sub
    Else                       '存在此用户名，检查密码
        rs.MoveFirst
       If rs.Fields("密码").Value = Trim(txtPWD.Text) Then  '密码正确
          Unload frmLogin           '卸载登录窗口
          Load frmMain              '加载主窗口
          frmMain.Show              '显示主窗口
       Else                '密码错误
          If num < 2 Then   '输入错误次数不足三次
              num = num + 1    '错误次数加1
              MsgBox "口令不对，请重输！" & vbCrLf & " 您还有" & Str(3 - num) & "次机会！", _
                    vbOKOnly + vbExclamation, "提示"       '提示错误
              txtPWD.SetFocus
              Exit Sub
          Else                     '输入错误打到3次，提示后退出系统
              MsgBox "对不起，您无权使用本系统！", vbOKOnly + vbExclamation, "提示"
              Unload frmLogin
              Exit Sub
          End If
       End If
    End If
    conn.Close                       '关闭数据库连接
End Sub

Private Sub Form_Load()
    connstring = "Provider=SQLOLEDB.1;Password=ecc;Persist Security Info=True;User ID=sa;" _
          & "Initial Catalog=PetrolStation System;Server=(local)"
    
    If conn.State <> 1 Then       '如果数据库未打开，则打开数据库
        conn.Open (connstring)
    End If
    Set rs = conn.Execute("select * from PS_Users")  '执行查询操作，结果保存在rs记录集中
    With rs
        .MoveFirst
        Do While Not .EOF               '  逐条读取用户名称，添加到cmbUserName组合框中
            DoEvents
            cmbUserName.AddItem (!用户)
            .MoveNext
        Loop
    End With
    cmbUserName.ListIndex = 0           '将cmbUserName组合框的默认选项设置为第一条
    conn.Close
End Sub