- VERSION 5.00
- Begin VB.Form frmLogin
- BorderStyle = 3 'Fixed Dialog
- Caption = "登录"
- ClientHeight = 3216
- ClientLeft = 36
- ClientTop = 336
- ClientWidth = 5100
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 3216
- ScaleWidth = 5100
- ShowInTaskbar = 0 'False
- StartUpPosition = 2 'CenterScreen
- Tag = "Login"
- Begin VB.CommandButton cmdCancel
- Cancel = -1 'True
- Caption = "取消"
- BeginProperty Font
- Name = "宋体"
- Size = 10.8
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 360
- Left = 2580
- TabIndex = 4
- Tag = "Cancel"
- Top = 1980
- Width = 1140
- End
- Begin VB.CommandButton cmdOK
- Caption = "确定"
- Default = -1 'True
- BeginProperty Font
- Name = "宋体"
- Size = 10.8
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 360
- Left = 960
- TabIndex = 3
- Tag = "OK"
- Top = 1980
- Width = 1140
- End
- Begin VB.TextBox txtPassword
- Height = 288
- IMEMode = 3 'DISABLE
- Left = 1788
- PasswordChar = "*"
- TabIndex = 2
- Top = 1488
- Width = 2325
- End
- Begin VB.TextBox txtUserName
- Height = 288
- Left = 1788
- TabIndex = 1
- Top = 1092
- Width = 2325
- End
- Begin VB.Label Label2
- Caption = "版权提供:LL Software Corp."
- BeginProperty Font
- Name = "仿宋_GB2312"
- Size = 15
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 372
- Left = 240
- TabIndex = 7
- Top = 2640
- Width = 4812
- End
- Begin VB.Label Label1
- Caption = "学生信息管理系统"
- BeginProperty Font
- Name = "华文彩云"
- Size = 22.2
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000002&
- Height = 612
- Left = 720
- TabIndex = 6
- Top = 240
- Width = 3852
- End
- Begin VB.Label lblLabels
- Caption = "用户密码"
- BeginProperty Font
- Name = "宋体"
- Size = 10.8
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 252
- Index = 1
- Left = 588
- TabIndex = 0
- Top = 1500
- Width = 1080
- End
- Begin VB.Label lblLabels
- Caption = "用户名"
- BeginProperty Font
- Name = "宋体"
- Size = 10.8
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 252
- Index = 0
- Left = 720
- TabIndex = 5
- Tag = "&User Name:"
- Top = 1116
- Width = 840
- End
- End
- Attribute VB_Name = "frmLogin"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
- Public OK As Boolean
- '记录确定次数
- Dim miCount As Integer
- Private Sub Form_Load()
- Dim sBuffer As String
- Dim lSize As Long
- sBuffer = Space$(255)
- lSize = Len(sBuffer)
- Call GetUserName(sBuffer, lSize)
- If lSize > 0 Then
- txtUserName.Text = ""
- Else
- txtUserName.Text = vbNullString
- End If
- OK = False
- miCount = 0
- End Sub
- Private Sub cmdCancel_Click()
- OK = False
- Me.Hide
- End Sub
- Private Sub cmdOK_Click()
- Dim txtSQL As String
- Dim mrc As ADODB.Recordset
- Dim MsgText As String
- 'ToDo: create test for correct password
- 'check for correct password
- UserName = ""
- If Trim(txtUserName.Text = "") Then
- MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
- txtUserName.SetFocus
- Else
- txtSQL = "select * from user_Info where user_ID = '" & txtUserName.Text & "'"
- Set mrc = ExecuteSQL(txtSQL, MsgText)
- If mrc.EOF = True Then
- MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
- txtUserName.SetFocus
- Else
- If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then
- OK = True
- mrc.Close
- Me.Hide
- UserName = Trim(txtUserName.Text)
- Else
- MsgBox "输入密码不正确,请重新输入!", vbOKOnly + vbExclamation, "警告"
- txtPassword.SetFocus
- txtPassword.Text = ""
- End If
- End If
- End If
- miCount = miCount + 1
- If miCount = 3 Then
- Me.Hide
- End If
- Exit Sub
- End Sub