frmuser.frm

学生管理信息系统

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form frmUser 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "系统登陆"
   ClientHeight    =   3060
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5820
   Icon            =   "frmUser.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmUser.frx":0CCA
   ScaleHeight     =   3060
   ScaleWidth      =   5820
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin MSDataListLib.DataCombo txtUserName 
      Bindings        =   "frmUser.frx":3144
      DataSource      =   "UserADO"
      Height          =   330
      Left            =   1590
      TabIndex        =   5
      Top             =   1260
      Width           =   2445
      _ExtentX        =   4313
      _ExtentY        =   582
      _Version        =   393216
      Style           =   2
      BackColor       =   16777215
      ForeColor       =   16744448
      ListField       =   "userName"
      BoundColumn     =   ""
      Text            =   "DataCombo1"
      Object.DataMember      =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.CheckBox checkPassWord 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Check1"
      Height          =   255
      Left            =   4380
      TabIndex        =   1
      Top             =   1850
      Width           =   220
   End
   Begin VB.TextBox txtUserPass 
      BorderStyle     =   0  'None
      DataField       =   "password"
      DataSource      =   "UserADO"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF80FF&
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1600
      MaxLength       =   15
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   1710
      Width           =   1750
   End
   Begin VB.Label cmdNewUser 
      BackStyle       =   0  'Transparent
      Height          =   300
      Left            =   180
      TabIndex        =   4
      Top             =   2660
      Width           =   1400
   End
   Begin VB.Label cmdOK 
      BackStyle       =   0  'Transparent
      Height          =   345
      Index           =   1
      Left            =   4920
      TabIndex        =   3
      Top             =   2640
      Width           =   840
   End
   Begin VB.Label cmdOK 
      BackStyle       =   0  'Transparent
      Height          =   350
      Index           =   0
      Left            =   3940
      TabIndex        =   2
      Top             =   2640
      Width           =   850
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim miCount As Integer
Private conn As ADODB.Connection
Private rs As ADODB.Recordset
Private rsmc As ADODB.Recordset
Public UserName As String                   '用户名
Private Sub cmdNewUser_Click()
 Load frmNewUser
 frmNewUser.Show (1)
End Sub

Private Sub cmdNewUser_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 cmdNewUser.BorderStyle = 1
End Sub

Private Sub cmdNewUser_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 cmdNewUser.BorderStyle = 0
End Sub

Private Sub cmdOK_Click(Index As Integer)
 Select Case Index
  Case 0
   inputMain            '调入系统登陆模块
  Case 1
    Unload Me: End
 End Select
End Sub

Private Sub cmdOK_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdOK(Index).BorderStyle = 1
End Sub

Private Sub cmdOK_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdOK(Index).BorderStyle = 0
End Sub

Private Sub Form_Activate()
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\xs.mdb"
conn.Open
Set rsmc = New ADODB.Recordset
rsmc.CursorLocation = adUseClient
rsmc.Open "user_Info", conn, 1, 1
Set txtUserName.RowSource = rsmc
txtUserName.ListField = "userName"
txtUserName.Text = "": txtUserPass.Text = "": txtUserName.SetFocus: txtUserName.Refresh
End Sub

Private Sub Form_Load()
miCount = 0
End Sub

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

Private Sub txtUserName_Click(Area As Integer)
 Dim txtSQL As String                           '检测是否已经记住密码
  txtSQL = "select * from user_Info where userName = '" & txtUserName.Text & "'"
  Set rs = New ADODB.Recordset
  rs.Open txtSQL, conn, 1, 1
  If rs.Fields(2) = "1" Then
   checkPassWord.Value = 1
   txtUserPass.Text = rs.Fields(1).Value
  Else
   checkPassWord.Value = 0
   txtUserPass.Text = ""
  End If
End Sub

Private Sub txtUserName_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = 13 Then txtUserPass.SetFocus
End Sub

Private Sub txtUserPass_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = 13 Then inputMain
End Sub

Sub inputMain()           '登入系统模块
   Dim txtSQL As String
   Dim MsgText As String
    UserName = ""
    If Trim(txtUserName.Text = "") Then
        MsgBox "用户名称不能为空，请选择用户名！", vbOKOnly + vbExclamation, "警告"
        txtUserName.SetFocus
    Else
        txtSQL = "select * from user_Info where userName = '" & txtUserName.Text & "'"
        Set rs = New ADODB.Recordset
        rs.Open txtSQL, conn, 2, 2
          If Trim(rs.Fields(1)) = Trim(txtUserPass.Text) Then
              If checkPassWord.Value = 1 Then
                rs.Fields(2).Value = 1
                rs.Update
              Else
                rs.Fields(2).Value = 0
                rs.Update
              End If
                rs.Close
                Me.Hide
                UserName = Trim(txtUserName.Text)
                 inputXTZZ                         '写入系统日志
                Load frmMain
                frmMain.Show
                Exit Sub
          Else
                MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
                txtUserPass.SetFocus
                txtUserPass.Text = ""
          End If
    End If
   
    miCount = miCount + 1
    If miCount = 3 Then
        MsgBox "输入密码错误超过三次，你无权进入系统，谢谢合作！", vbOKOnly + vbQuestion, "提示"
        Unload Me
        End
    End If
    Exit Sub
End Sub

Sub inputXTZZ()                             '写入系统日志模块
   Set rs = New ADODB.Recordset
   rs.CursorLocation = adUseClient
   rs.Open "xtZZ", conn, 2, 2
    rs.AddNew
    rs.Fields(0) = UserName
    rs.Fields(1) = Format(Date, "yyyy年mm月dd日")
    rs.Fields(2) = Format(Time, "hh:mm:ss AM/PM")
    rs.Update
    rs.Close
End Sub