看书上看了个程序,打开源代码运行,总是出错登录界面代码如下:
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()
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
'变量定义 txtSQL是用来存放SQL语句,MsgText存放返回信息
UserName = ""
If Trim(txtUserName.Text = "") Then
'判断用户名输入是否为空
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
txtUserName.SetFocus
Else
txtSQL = "select * from Manager where username = '" & 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
'记录密码输入的次数,累计到3此则自动结束程序
Me.Hide
End If
Exit Sub
End Sub
模块代码如下:
Public fMainForm As frmMain '程序主窗体
Public UserName As String '用户名
Public PWD As String '用户密码
Public CONN As String '数据库连接字符串-------------------------------------------------------------------------------
Sub Main()
CONN = "FileDSN=Reality.dsn;UID=sa;PWD="
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
-------------------------------------------------------------------------------
Public Function ExecuteSQL(ByVal SQL _
As String, MsgString As String) _
As ADODB.Recordset
'executes SQL and returns 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 CONN
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 'get RecordCount
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 Testtxt(txt As String) As Boolean
If Trim(txt) = "" Then
Testtxt = False
Else
Testtxt = True
End If
End Function总是运行到蓝色的地方,If mrc.EOF = True Then,报错,出现“实时错误‘91’对象变量或WITH 块变量未设置”
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()
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
'变量定义 txtSQL是用来存放SQL语句,MsgText存放返回信息
UserName = ""
If Trim(txtUserName.Text = "") Then
'判断用户名输入是否为空
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
txtUserName.SetFocus
Else
txtSQL = "select * from Manager where username = '" & 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
'记录密码输入的次数,累计到3此则自动结束程序
Me.Hide
End If
Exit Sub
End Sub
模块代码如下:
Public fMainForm As frmMain '程序主窗体
Public UserName As String '用户名
Public PWD As String '用户密码
Public CONN As String '数据库连接字符串-------------------------------------------------------------------------------
Sub Main()
CONN = "FileDSN=Reality.dsn;UID=sa;PWD="
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
-------------------------------------------------------------------------------
Public Function ExecuteSQL(ByVal SQL _
As String, MsgString As String) _
As ADODB.Recordset
'executes SQL and returns 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 CONN
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 'get RecordCount
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 Testtxt(txt As String) As Boolean
If Trim(txt) = "" Then
Testtxt = False
Else
Testtxt = True
End If
End Function总是运行到蓝色的地方,If mrc.EOF = True Then,报错,出现“实时错误‘91’对象变量或WITH 块变量未设置”
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货