Option Explicit
Dim n As Integer

Private Sub Form_Load()
n = 0
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command1_Click()
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
txtSQL = "select * from c001 where username='"
Trim$ (Text1(0).Text) & "'" & "and txtPassword='"
Trim$ (Text1(1).Text)
Set mrc = exeSQL(txtSQL)
If mrc.RecordCount = 0 Then '－－－为什么这里提示错误？？？
n = n + 1

If n < 3 Then
MsgBox "没有这个用户，继续登陆 ", vbOKOnly + vbExclamation, "信息提示"
Text1(0).Text = ""
Text1(1).Text = ""
Text1(0).SetFocus

Else
MsgBox "已经登陆三次，退出系统", vbOKOnly + vbExclamation, "信息提示"
Unload Me
End If

Else
userlevel = Trim(mrc.Fields("userleve"))
mrc.Close
Unload Me
frmMain.Show
End If
End Sub

Private Sub Text1_KeyPress(intex As Integer, KeyAscii As Integer)
Call endata(KeyAscii)
End Sub


模块代码是
Option Explicit
Public userlevel As String
Public adoCon As New ADODB.Connection
Public Cmd As New ADODB.Command
Public UserCode As String
Public UserName As String
Public OldSort As Integer

Sub main()
frmLogin.Show vbModal
End Sub

Public Function ConnectString() As String

ConnectString = "FileDSN=card.dsn;UID=sa;PWD="
End Function

Public Function exeSQL(ByVal SQL As String) As ADODB.Recordset

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
SQL = Trim$(SQL)
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
conn.Open ConnectString
Set rst.ActiveConnection = conn
rst.LockType = adLockOptimistic
rst.CursorType = adOpenKeyset
rst.Open ConnectString
Set exeSQL = rst
Set rst = Nothing
Set conn = Nothing
End Function
Public Sub endata(Keyasc As Integer)
If Keyasc = 13 Then
SendKeys "{TAB}"
End If
End Sub

请高手帮忙修正下～～
万分感谢！！！！！

[此贴子已经被作者于2006-6-5 22:35:15编辑过]

''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'程 序 员 : 梁 嘉 辉
'编 写 时 间 : 2006-5-17
'模 块 功 能 : 实现多用户登录
'E - Mail : purana@126.com
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim g_Connect As ADODB.Connection
Dim g_Recordset As ADODB.Recordset

Private Sub Command1_Click()
Static userCount As Integer
Dim i As Integer
For i = 0 To 2
If Text1(i).Text = "" Then
MsgBox "內容不能為空,請輸入!", vbExclamation + vbOKOnly
Text1(i).SetFocus
Exit Sub
End If
Next
If Text1(1).Text <> Text1(2).Text Then
MsgBox "兩次密碼不正確,請重新輸入"
Text1(1).SetFocus
Exit Sub
End If
Set g_Recordset = CreateObject("ADODB.Recordset")
Dim sql As String
sql = "SELECT * FROM user_info WHERE 用戶名='" & Text1(0).Text & "'"
g_Recordset.Open sql, g_Connect, adOpenKeyset, adLockPessimistic
If g_Recordset.RecordCount <= 0 Then
MsgBox "沒有此用戶,請重新輸入!", vbCritical + vbOKOnly
userCount = userCount + 1
g_Recordset.Close
'Exit Sub
Else
If Text1(1).Text = g_Recordset.Fields("密碼").Value Then
MsgBox "密碼正確,登錄成功!", vbOKCancel
Form2.Show
g_Recordset.Close
Unload Me
Else
MsgBox "密碼不正確,請確定密碼!"
Text1(1).SetFocus
userCount = userCount + 1
'Exit Sub
End If
End If
If userCount >= 3 Then
MsgBox "你已經超出使用權限了,不能再使用本軟件!"
End
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim iConnstr As String
Set g_Connect = CreateObject("ADODB.Connection")
iConnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\student.mdb;Persist Security Info=False"
g_Connect.Open iConnstr
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set g_Connect = Nothing
Set g_Recordset = Nothing
End Sub