请斑竹和各位仁兄、仁弟看看这个程序
这是一本书上的程序,意思是系统启动后启动frmlogin.frm对话框,输入用户名和用户密码.如果输入的用户名在用户表格中没有找到,将提示重新输入用户名,文本框将重新获得输入焦点.用户登录成功,全局变量OK将被赋值为true,一旦三次输入密码不正确,全局变量OK将被赋值为false,公用模块中的main过程将根据OK的值决定是退出或者进入系统.我照着书上做,但始终调不通.出现的提示是倒数第26行
(If mrc.EOF = True Then)
"实时错误'91'"
"对象变量或WITH块变量未设置"
不知是什么意思??
module1.bas
Public username As String
Public Function Executesql(ByVal SQL As String, MsgString As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stokens() As String
On Error GoTo Executesql_error
stokens = Split(SQL)
Set cnn = New ADODB.Connection
cnn.Open ConnectionString
If InStr("INSERT,DELETE,UPDATE", UCase$(stokens(0))) Then
cnn.Execute SQL
MsgString = stokens(0) & "query successful"
Else
Set rst = New ADODB.Recordset
rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic
'rst.MoveLast
Set Executesql = rst
MsgString = "查询到" & rst.RecordCount & "条记录"
End If
Executesql_exit:
Set rst = Nothing
Set cnn = Nothing
Exit Function
Executesql_error:
MsgString = "查询错误" & Err.Description
Resume Executesql_exit
End Function
Public Function connectstring() As String
connectstring = "FileDSN=myconnection.dsn;UID=sa,PWD="
End Function
Public Function testtxt(txt As String) As Boolean
If Trim(txt) = "" Then
testtxt = False
Else
testtxt = True
End If
End Function
Sub main()
Dim flogin As New frmlogin
flogin.Show vbModal
If Not flogin.ok Then
End
End If
Unload flogin
Set fmainform = New frmmain
fmainform.Show
End Sub
frmlogin.frm
Option Explicit
Public ok As Boolean
Dim micount As Integer
Private Sub cmdok_Click()
Dim Txtsql As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
username = ""
If Trim(txtusername.Text = "") Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
Txtsql = "select * from user_info where user_info.user_id= trim(txtusername.Text) "
Set mrc = Executesql(Txtsql, msgtext)
txtusername.SetFocus
Else
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
Private Sub Form_Load()
ok = False
micount = 0
End Sub
问题点数:100、回复次数:10Top
1 楼yatingz(学习者)回复于 2002-07-27 12:05:58 得分 0
这是一本书上的程序,意思是系统启动后启动frmlogin.frm对话框,输入用户名和用户密码.如果输入的用户名在用户表格中没有找到,将提示重新输入用户名,文本框将重新获得输入焦点.用户登录成功,全局变量OK将被赋值为true,一旦三次输入密码不正确,全局变量OK将被赋值为false,公用模块中的main过程将根据OK的值决定是退出或者进入系统.我照着书上做,但始终调不通.出现的提示是倒数第26行
(If mrc.EOF = True Then)
"实时错误'91'"
"对象变量或WITH块变量未设置"
不知是什么意思??
module1.bas
Public username As String
Public Function Executesql(ByVal SQL As String, MsgString As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stokens() As String
On Error GoTo Executesql_error
stokens = Split(SQL)
Set cnn = New ADODB.Connection
cnn.Open ConnectionString
If InStr("INSERT,DELETE,UPDATE", UCase$(stokens(0))) Then
cnn.Execute SQL
MsgString = stokens(0) & "query successful"
Else
Set rst = New ADODB.Recordset
rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic
'rst.MoveLast
Set Executesql = rst
MsgString = "查询到" & rst.RecordCount & "条记录"
End If
Executesql_exit:
Set rst = Nothing
Set cnn = Nothing
Exit Function
Executesql_error:
MsgString = "查询错误" & Err.Description
Resume Executesql_exit
End Function
Public Function connectstring() As String
connectstring = "FileDSN=myconnection.dsn;UID=sa,PWD="
End Function
Public Function testtxt(txt As String) As Boolean
If Trim(txt) = "" Then
testtxt = False
Else
testtxt = True
End If
End Function
Sub main()
Dim flogin As New frmlogin
flogin.Show vbModal
If Not flogin.ok Then
End
End If
Unload flogin
Set fmainform = New frmmain
fmainform.Show
End Sub
frmlogin.frm
Option Explicit
Public ok As Boolean
Dim micount As Integer
Private Sub cmdok_Click()
Dim Txtsql As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
username = ""
If Trim(txtusername.Text = "") Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
Txtsql = "select * from user_info where user_info.user_id= trim(txtusername.Text) "
Set mrc = Executesql(Txtsql, msgtext)
txtusername.SetFocus
Else
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
Private Sub Form_Load()
ok = False
micount = 0
End Sub
Top
2 楼duckcn(duck)回复于 2002-07-27 12:12:08 得分 0
try
Dim mrc As new ADODB.Recordset
Top
3 楼yatingz(学习者)回复于 2002-07-27 12:45:13 得分 0
改过之后又出现下面提示:
the operation requested by the application is not allowed if the objection is closedTop
4 楼yatingz(学习者)回复于 2002-07-27 12:55:38 得分 0
请帮帮我!!!!Top
5 楼yatingz(学习者)回复于 2002-07-27 16:13:05 得分 0
如果能告诉我怎么改,将有大分赠送Top
6 楼matboy()回复于 2002-07-27 16:33:23 得分 0
问题出在Private Sub cmdok_Click()里
首先,使用ADODB。RECORDSET 必须用NEW关键字
其次,你的逻辑有问题,你看,如果我输入的用户名不是空,但也不是空格,在第一个条件语句中就会跳到ELSE 部分执行,那么MRC根本就不会打开,没有打开却使用了MRC。EOF 当然会出错,因为这个对象根本就不存在么!
If Trim(txtusername.Text = "") Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
Txtsql = "select * from user_info where user_info.user_id= trim(txtusername.Text) "
Set mrc = Executesql(Txtsql, msgtext)
txtusername.SetFocus
Else
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
欢迎交流!
我使用了CSDN论坛助手,感谢作者CHINAOK!
Top
7 楼matboy()回复于 2002-07-27 16:37:42 得分 0
问题出在Private Sub cmdok_Click()里
首先,使用ADODB。RECORDSET 必须用NEW关键字
其次,你的逻辑有问题,你看,如果我输入的用户名不是空,但也不是空格,在第一个条件语句中就会跳到ELSE 部分执行,那么MRC根本就不会打开,没有打开却使用了MRC。EOF 当然会出错,因为这个对象根本就不存在么!
If Trim(txtusername.Text = "") Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
Txtsql = "select * from user_info where user_info.user_id= trim(txtusername.Text) "
Set mrc = Executesql(Txtsql, msgtext)
txtusername.SetFocus
Else
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
欢迎交流!
我使用了CSDN论坛助手,感谢作者CHINAOK!
Top
8 楼yatingz(学习者)回复于 2002-07-28 08:10:27 得分 0
请各位帮帮忙!!帮我把这个程序改一下,谢谢!!!!!Top
9 楼fontz(方舟)回复于 2002-07-28 12:37:19 得分 10
不用数据库,建立一个二进制文件保存用户和密码。Top
10 楼student_01(相约今天)回复于 2002-07-31 09:02:21 得分 90
可以照下面的方法改一下就可以了:
dim rs as new ADODB.Recordset
With rs
.ActiveConnection = "DRIVER=SQL Server;" & "SERVER=(local);" & "UID=sa;" & "WSID=SOFT;" & "DATABASE=dlxt;" & "LANGUAGE=us_english"
.Source = "insert 电力能耗表(数量,日期,记录人) values(" & sl & ",'" & rq & "','" & jlr & "')"
.Open
End WithTop




