dlglogin.frm

考试分析系统 v0.6.0

VERSION 5.00
Begin VB.Form Dlglogin 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户登陆"
   ClientHeight    =   1905
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3810
   Icon            =   "Dlglogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1905
   ScaleWidth      =   3810
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox CmbUser 
      ForeColor       =   &H80000001&
      Height          =   300
      ItemData        =   "Dlglogin.frx":0ECA
      Left            =   1440
      List            =   "Dlglogin.frx":0ECC
      TabIndex        =   0
      Text            =   "请选择..."
      Top             =   188
      Width           =   2055
   End
   Begin VB.CheckBox Check1 
      BackColor       =   &H80000001&
      Caption         =   "记住密码"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   1080
      Value           =   1  'Checked
      Width           =   3135
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   2280
      TabIndex        =   4
      Top             =   1440
      Width           =   975
   End
   Begin VB.CommandButton Cmdok 
      Caption         =   "确定"
      Height          =   375
      Left            =   480
      TabIndex        =   3
      Top             =   1440
      Width           =   975
   End
   Begin VB.TextBox Txtpassword 
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   1440
      MaxLength       =   12
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   678
      Width           =   2055
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "密    码："
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800080&
      Height          =   240
      Left            =   240
      TabIndex        =   6
      Top             =   720
      Width           =   1200
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用 户 名："
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800080&
      Height          =   240
      Left            =   240
      TabIndex        =   5
      Top             =   240
      Width           =   1200
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   2940
      Left            =   0
      Picture         =   "Dlglogin.frx":0ECE
      Stretch         =   -1  'True
      Top             =   0
      Width           =   4440
   End
End
Attribute VB_Name = "Dlglogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim miCount As Integer

Private Sub CmbUser_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then cmdOK_Click
End Sub

Private Sub cmdCancel_Click()
   Me.Hide
End Sub

Private Sub cmdOK_Click()
  Dim txtSQL As String
  Set mrc = New ADODB.Recordset
  
    If Trim(CmbUser.Text) = "" Then
        CmbUser.SetFocus
    Else
      txtSQL = "select * from Login where 登录姓名 = '" & CmbUser.Text & "'"
      mrc.Open Trim$(txtSQL), Con, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = mrc
      
        If mrc.EOF = True Then
            CmbUser.SetFocus
        Else
            If Trim(mrc!密码) = Trim(Txtpassword.Text) Then
                LoginUser = mrc!登录姓名
                Permission = mrc!权限
                If Check1.Value = 1 Then
                    r = WritePrivateProfileString("用户信息", "姓名", CmbUser.Text, App.Path + "\考试分析系统.ini")
                    s = WritePrivateProfileString("用户信息", "密码", Txtpassword.Text, App.Path + "\考试分析系统.ini")
                    If r <> 1 Or s <> 1 Then
                       MsgBox "写基本信息出错！", 48, App.Title
                     End If
                Else
                    r = WritePrivateProfileString("用户信息", "姓名", "", App.Path + "\考试分析系统.ini")
                    s = WritePrivateProfileString("用户信息", "密码", "", App.Path + "\考试分析系统.ini")
                End If
                mrc.Close
                Me.Hide
                Exit Sub
            Else
                Txtpassword.SetFocus
                Txtpassword.Text = ""
            End If
        End If
    End If
    
    miCount = miCount + 1
    MsgBox "登录错误，你还有" & 3 - miCount & "次机会！", vbOKOnly + vbExclamation, "警告"
    If miCount = 3 Then
        Me.Hide
    End If
    Exit Sub
End Sub

Private Sub Form_Load()
If Len(GetFromINI("用户信息", "姓名", App.Path + "\考试分析系统.ini")) = 0 Or Len(GetFromINI("用户信息", "密码", App.Path + "\考试分析系统.ini")) = 0 Then
Else
CmbUser.Text = GetFromINI("用户信息", "姓名", App.Path + "\考试分析系统.ini")
Txtpassword.Text = GetFromINI("用户信息", "密码", App.Path + "\考试分析系统.ini")
End If
  Dim Rs1 As ADODB.Recordset
  Set Rs1 = New ADODB.Recordset
  Rs1.Open "Login", Con, adOpenStatic, adCmdTable
    icount = 0
    If Rs1.BOF And Rs1.EOF Then
    MsgBox "请用管理员账号登录"
    Exit Sub
    End If
Rs1.MoveFirst
Do While Rs1.EOF = False
  CmbUser.AddItem Rs1!登录姓名, i
  i = i + 1
  Rs1.MoveNext
Loop

End Sub

Private Sub Txtpassword_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then cmdOK_Click
End Sub