frmlogin.frm

对学习VB很有帮助 fskdljfl kasdjfkl asdjfk lajsd f

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录"
   ClientHeight    =   2820
   ClientLeft      =   10050
   ClientTop       =   3480
   ClientWidth     =   3810
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1666.149
   ScaleMode       =   0  'User
   ScaleWidth      =   3577.384
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox cbousertype 
      Height          =   300
      ItemData        =   "frmLogin.frx":1042
      Left            =   1560
      List            =   "frmLogin.frx":104C
      TabIndex        =   3
      Top             =   1440
      Width           =   1455
   End
   Begin VB.TextBox txtUserName 
      Height          =   345
      Left            =   1560
      MaxLength       =   20
      TabIndex        =   1
      Text            =   "admin"
      Top             =   135
      Width           =   1485
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   390
      Left            =   720
      TabIndex        =   4
      Top             =   1920
      Width           =   900
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   390
      Left            =   1920
      TabIndex        =   5
      Top             =   1920
      Width           =   900
   End
   Begin VB.TextBox txtPassword 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1560
      MaxLength       =   20
      PasswordChar    =   "*"
      TabIndex        =   2
      Text            =   "admin"
      Top             =   840
      Width           =   1485
   End
   Begin VB.Label Label1 
      Caption         =   "选择用户类型:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   7
      Top             =   1440
      Width           =   1455
   End
   Begin VB.Label lblLabels 
      Caption         =   "用户名称(&U):"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1560
   End
   Begin VB.Label lblLabels 
      Caption         =   "密码(&P):"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Index           =   1
      Left            =   600
      TabIndex        =   6
      Top             =   840
      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


Dim usertype1 As String
Dim cmd As New ADODB.Command
Dim r As New ADODB.Recordset

Private Sub cbousertype_Click()
usertype1 = Trim(cbousertype.Text)
 
End Sub

Private Sub cmdCancel_Click()
 End
End Sub

Private Sub cmdOK_Click()
     ''取得用户输入的用户名和密码
    Dim user As String, pwd As String
     Static nTryCount As Integer
    user = txtUserName
    pwd = txtPassword
   
    If txtUserName = "" Then
        MsgBox "请输入用名!", vbOKCancel, "注意"
        txtUserName.SetFocus
        txtUserName.SelStart = 0
        txtUserName.SelLength = Len(txtUserName)
        nTryCount = nTryCount + 1
         If nTryCount > 2 Then
        MsgBox "输入已三次,您不能使用本系统!", vbOKCancel, "警告"
        End
        End If
        Exit Sub
    End If
    If txtPassword = "" Then
         MsgBox "请输入密码!", vbOKCancel, "注意"
        txtUserName.SetFocus
        txtUserName.SelStart = 0
        txtUserName.SelLength = Len(txtUserName)
        nTryCount = nTryCount + 1
         If nTryCount > 2 Then
        MsgBox "输入已三次,您不能使用本系统!", vbOKCancel, "警告"
        End
    End If
        Exit Sub
    End If
        
    If cbousertype.Text = "" Then
     MsgBox "请选择用户类型"
     nTryCount = nTryCount + 1
      If nTryCount > 2 Then
        MsgBox "输入已三次,您不能使用本系统!", vbOKCancel, "警告"
        End
    End If
     Exit Sub
     End If
    If usertype1 = "管理员" Then
        usertype = True
    Else
        usertype = False
    End If
    If conn.State = adStateClosed Then  '如果数据库是打开的,就不再打开
    Call opendatabase
    End If
        Set cmd.ActiveConnection = conn
     Dim strSQL As String
     strSQL = "select * from 管理人员 where username='"
     strSQL = strSQL & user & "' and password='"
     strSQL = strSQL & pwd & "' and admin=" & usertype
     cmd.CommandText = strSQL
     cmd.CommandType = adCmdText
    Set r = cmd.Execute    '进行查询管理人员表
        
    
    
   If Not r.EOF Then
        ym = r.Fields("username")  '记录当前登录的用户名
        main.Show
        Unload Me
    Else
        nTryCount = nTryCount + 1
        If nTryCount > 2 Then    ''用户密码错误的次数，如果错误次数超过3次，则退出系统
            MsgBox "对不起，输入次数已超过3次。系统即将关闭！", vbCritical, "抱歉！"
            End
            
        End If
     MsgBox "对不起，无此用户或者密码或权限不正确！请重新输入或者重新注册！！", vbCritical, "错误"
            txtUserName.SetFocus
            txtUserName.SelStart = 0
      txtUserName.SelLength = Len(txtUserName)
      
    End If
End Sub

Private Sub Combo1_Change()
 
End Sub

Private Sub Command1_Click()
Frm_AddUser.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
conn.Close
Set conn = Nothing
End Sub