主题:关于小区物业管理系统软件
这是一个小区物业管理系统中系统用户管理的代码,在调试时弹出一个框,“编译错误无效使用NEW语句”求解啊,(补补充下,用VB+Access编的)
Option Explicit
Dim objcopy As New Recordset, isadding As Boolean
Private Sub cmbstatus_Change()
If Trim(cmbstatus) = "" Or isadding Then
cmdadd.Enabled = False
Else
cmdadd.Enabled = True
End Sub
Private Sub cmdadd_Click()
Adodc1.Recordset.AddNew '添加新纪录
cmdadd.Enabled = False '在保存新记录之前禁用
cmbstatus.ListIndex = 1
cmddelete.Enabled = False: Adodc1.Enabled = False
txtUser.Locked = False: isadding = True
End Sub
Private Sub cmddelete_Click()
Adodc1.Refresh '刷新记录集
cmdadd.Enabled = True: cmddelete.Enabled = True '启用控件
txtUser.Locked = True: Adodc1.Enabled = True
isadding = False
Set objcopy = Adodc1.Recordset.Clone
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdrefresh_Click()
Adodc1.Refresh
cmdadd.Enabled = True '刷新记录
cmddelete.Enabled = True '启用控件
txtUser.Locked = True
Adodc1.Enabled = True
isadding = False
Set objcopy = Adodc1.Recordset.Clone
End Sub
Private Sub cmdsave_Click()
If Trim(txtUser) = "" Then
MsgBox "用户名不能为空!", vbCritical, "系统用户管理"
txtUser = "": txtUser.SetFocus
ElseIf Trim(txtPWD) = "" Then
MsgBox "口令为空!", vbCritical, "系统用户管理"
txtPWD = "": txtPWD.SetFocus
ElseIf Trim(cmbstatus) = "" Then
MsgBox "用户身份不能为空!", vbCritical, "系统用户管理"
cmbstatus = "": cmbstatus.SetFocus
Else
With objcopy
If .RecordCount > 0 Then
.MoveFirst
.Find "用户名=""'&trim(txtuser)&'"
If Not .EOF And .AbsolutePosition <> _
Adodc1.Recordset.AbsolutePosition Then
MsgBox "用户名:" & Trim(txtUser) & "已被使用,请使用其他用户名!", vbCritical, "系统用户管理"
txtUser.SetFocus
txtUser.SelStart = 0: txtUser.SelLength = Len(txtUser)
Exit Sub
End If
End If
End With
Adodc1.Recordset.Update
MsgBox "数据保存成功!", vbInformation, "系统用户管理"
cmdadd.Enabled = True
cmddelete.Enabled = True: Adodc1.Enabled = True
txtUser.Locked = True: isadding = False
Set objcopy = Adodc1.Recordset.Clone
End If
End Sub
Private Sub Form_Load()
Set objcopy = Adodc1.Recordset.Clone '创建Adodc1记录集副本
cmdrefresh.Value = True '执行刷新操作
End Sub
Private Sub txtPWD_Change()
If Trim(txtPWD) = "" Or isadding Then
cmdadd.Enabled = False
Else
cmdadd.Enabled = True
End Sub
Private Sub txtPWD_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= vbKey0 And KeyAscii <= vbKey9 _
Or KeyAscii >= vbKeyA And KeyAscii <= vbKeyZ _
Or KeyAscii >= vbKeyA And KeyAscii <= vbKeyZ _
Or KeyAscii = vbKeyBack) Then
KeyAscii = 0 '输入不是数字、英文字母或退格键,取消输入
End If
End Sub
Private Sub txtusername_keypess(KeyAscii As Integer)
If Not (KeyAscii >= Asc("a") And KeyAscii <= Asc("z") _
Or KeyAscii >= Asc("A") And KeyAscii <= Asc("Z") _
Or KeyAscii = vbKeyBack) Then
'如果输入不是英文字母或退格键,则取消输入
KeyAscii = 0
End If
End Sub
Private Sub txtuser_Change()
If Trim(txtUser) = "" Or isadding Then cmdadd.Enabled = False _
Else cmdadd.Enabled = True
End Sub
Private Sub Adodc1_WillChangeRecord(ByVal adReason As EventReasonEnum, ByVal _
cRecords As Long, adStatus As EventStatusEnum, ByVal pRecordset As Recordset)
If Trim(txtUser) = "" Then
MsgBox "用户名不能为空!", vbCritical, "系统用户管理"
txtUser = "": txtUser.SetFocus
ElseIf Trim(txtPWD) = "" Then
MsgBox "口令为空!", vbCritical, "系统用户管理"
txtPWD = "": txtPWD.SetFocus
ElseIf Trim(cmbstatus) = "" Then
MsgBox "用户身份不能为空!", vbCritical, "系统用户管理"
cmbstatus = "": cmbstatus.SetFocus
End If
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As EventReasonEnum, _
ByVal pError As Error, adStatus As EventStatusEnum, _
ByVal pRecordset As Recordset)
With Adodc1.Recordset
If .AbsolutePosition > 0 Then
Adodc1.Caption = "当前记录:" & .AbsolutePosition & "/" & .RecordCount
Else
Adodc1.Caption = "无系统用户数据"
End If
End With
End Sub
帮忙看看系统登录代码,代码如下:
Option Explicit
'定义允许用户验证登录信息的最大次数
Const MaxLogTimes As Integer = 3
Private Sub cmdCancel_Click()
'请求用户确认是否真的退出系统登录
If MsgBox("你选择了退出系统登录,退出将不能启动管理系统!" & vbCrLf & "是否真的退出?", vbYesNo, "登录验证") = vbYes Then
Unload Me
End If
End Sub
Private Sub cmdOK_Click()
'静态常量intLogTimes用于保存用户请求验证的次数
Static intLogTimes As Integer
intLogTimes = intLogTimes + 1 '保证登录次数
If intLogTimes > MaxLogTimes Then
'超过允许的登录次数,显示提示信息
MsgBox "你应经超过允许的登录验证次数!" & vbCr & "应用程序将结束!", vbCritical, "登录验证"
End
Else
'检查用户名和口令的合法性,并根据检验返回值执行相应的操作
Select Case check_password()
Case 0
MsgBox txtlog(0) & "不是系统用户" & "请检查用户名输入是否正确!", vbCritical, "登录验证"
txtlog(0).SetFocus
txtlog(0).SelStart = 0: txtlog(0).SelLength = Len(txtlog(0))
Case 1
MsgBox "口令错误,请重新输入!", vbCritical, "登录验证"
txtlog(1) = "": txtlog(1).SetFocus
Case 2
Unload Me
MsgBox " 登录成功,将启动系统管理程序!", vbInformation, "登录验证"
frmsysmain.Show '显示系统主窗体
Case Else
MsgBox "登录验证未正常完成!请重新运行登录程序," & vbCrLf & "如果仍不能登录,请报告系统管理员!", _
vbCritical, " 登录验证"
End Select
End If
End Sub
Private Function check_password() As Byte
On Error GoTo gperror
Dim objcn As New Connection
Dim objrs As New Recordset
Dim strCn As String, strsql As String
'建立数据库连接
strCn = "Provider=MSDASQL.1;Persist Security Info=false;" & "data source= 物管数据DSN"
objcn.connectionstring = strCn
objcn.ConnectionTimeout = 30
objcn.Open
'执行查询命令,获得用户登录口令
strsql = "select*from 系统用户 Where 用户名=" '&txtlog(0)&'""
Set objrs.ActiveConnection = objcn
objrs.Open (strsql)
If objrs.EOF Then
check_password = 0 '没有查询结果,表示该用户为非法用户
Else
If txtlog(1) <> Trim(objrs.Fields("口令")) Then
check_password = 1 '口令不正确
Else
check_password = 2 '口令正确
'保存用户信息
CurrentUserName = objrs.Fields("用户名")
CurrentUserPassword = objrs.Fields("口令")
CurrentUserStatus = objrs.Fields("身份")
End If
End If
'关闭数据库连接,释放对象
objcn.Close
Set objrs = Nothing
Set objcn = Nothing
Exit Function
gperror:
check_password = 225
End Function
Option Explicit
Dim objcopy As New Recordset, isadding As Boolean
Private Sub cmbstatus_Change()
If Trim(cmbstatus) = "" Or isadding Then
cmdadd.Enabled = False
Else
cmdadd.Enabled = True
End Sub
Private Sub cmdadd_Click()
Adodc1.Recordset.AddNew '添加新纪录
cmdadd.Enabled = False '在保存新记录之前禁用
cmbstatus.ListIndex = 1
cmddelete.Enabled = False: Adodc1.Enabled = False
txtUser.Locked = False: isadding = True
End Sub
Private Sub cmddelete_Click()
Adodc1.Refresh '刷新记录集
cmdadd.Enabled = True: cmddelete.Enabled = True '启用控件
txtUser.Locked = True: Adodc1.Enabled = True
isadding = False
Set objcopy = Adodc1.Recordset.Clone
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdrefresh_Click()
Adodc1.Refresh
cmdadd.Enabled = True '刷新记录
cmddelete.Enabled = True '启用控件
txtUser.Locked = True
Adodc1.Enabled = True
isadding = False
Set objcopy = Adodc1.Recordset.Clone
End Sub
Private Sub cmdsave_Click()
If Trim(txtUser) = "" Then
MsgBox "用户名不能为空!", vbCritical, "系统用户管理"
txtUser = "": txtUser.SetFocus
ElseIf Trim(txtPWD) = "" Then
MsgBox "口令为空!", vbCritical, "系统用户管理"
txtPWD = "": txtPWD.SetFocus
ElseIf Trim(cmbstatus) = "" Then
MsgBox "用户身份不能为空!", vbCritical, "系统用户管理"
cmbstatus = "": cmbstatus.SetFocus
Else
With objcopy
If .RecordCount > 0 Then
.MoveFirst
.Find "用户名=""'&trim(txtuser)&'"
If Not .EOF And .AbsolutePosition <> _
Adodc1.Recordset.AbsolutePosition Then
MsgBox "用户名:" & Trim(txtUser) & "已被使用,请使用其他用户名!", vbCritical, "系统用户管理"
txtUser.SetFocus
txtUser.SelStart = 0: txtUser.SelLength = Len(txtUser)
Exit Sub
End If
End If
End With
Adodc1.Recordset.Update
MsgBox "数据保存成功!", vbInformation, "系统用户管理"
cmdadd.Enabled = True
cmddelete.Enabled = True: Adodc1.Enabled = True
txtUser.Locked = True: isadding = False
Set objcopy = Adodc1.Recordset.Clone
End If
End Sub
Private Sub Form_Load()
Set objcopy = Adodc1.Recordset.Clone '创建Adodc1记录集副本
cmdrefresh.Value = True '执行刷新操作
End Sub
Private Sub txtPWD_Change()
If Trim(txtPWD) = "" Or isadding Then
cmdadd.Enabled = False
Else
cmdadd.Enabled = True
End Sub
Private Sub txtPWD_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= vbKey0 And KeyAscii <= vbKey9 _
Or KeyAscii >= vbKeyA And KeyAscii <= vbKeyZ _
Or KeyAscii >= vbKeyA And KeyAscii <= vbKeyZ _
Or KeyAscii = vbKeyBack) Then
KeyAscii = 0 '输入不是数字、英文字母或退格键,取消输入
End If
End Sub
Private Sub txtusername_keypess(KeyAscii As Integer)
If Not (KeyAscii >= Asc("a") And KeyAscii <= Asc("z") _
Or KeyAscii >= Asc("A") And KeyAscii <= Asc("Z") _
Or KeyAscii = vbKeyBack) Then
'如果输入不是英文字母或退格键,则取消输入
KeyAscii = 0
End If
End Sub
Private Sub txtuser_Change()
If Trim(txtUser) = "" Or isadding Then cmdadd.Enabled = False _
Else cmdadd.Enabled = True
End Sub
Private Sub Adodc1_WillChangeRecord(ByVal adReason As EventReasonEnum, ByVal _
cRecords As Long, adStatus As EventStatusEnum, ByVal pRecordset As Recordset)
If Trim(txtUser) = "" Then
MsgBox "用户名不能为空!", vbCritical, "系统用户管理"
txtUser = "": txtUser.SetFocus
ElseIf Trim(txtPWD) = "" Then
MsgBox "口令为空!", vbCritical, "系统用户管理"
txtPWD = "": txtPWD.SetFocus
ElseIf Trim(cmbstatus) = "" Then
MsgBox "用户身份不能为空!", vbCritical, "系统用户管理"
cmbstatus = "": cmbstatus.SetFocus
End If
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As EventReasonEnum, _
ByVal pError As Error, adStatus As EventStatusEnum, _
ByVal pRecordset As Recordset)
With Adodc1.Recordset
If .AbsolutePosition > 0 Then
Adodc1.Caption = "当前记录:" & .AbsolutePosition & "/" & .RecordCount
Else
Adodc1.Caption = "无系统用户数据"
End If
End With
End Sub
帮忙看看系统登录代码,代码如下:
Option Explicit
'定义允许用户验证登录信息的最大次数
Const MaxLogTimes As Integer = 3
Private Sub cmdCancel_Click()
'请求用户确认是否真的退出系统登录
If MsgBox("你选择了退出系统登录,退出将不能启动管理系统!" & vbCrLf & "是否真的退出?", vbYesNo, "登录验证") = vbYes Then
Unload Me
End If
End Sub
Private Sub cmdOK_Click()
'静态常量intLogTimes用于保存用户请求验证的次数
Static intLogTimes As Integer
intLogTimes = intLogTimes + 1 '保证登录次数
If intLogTimes > MaxLogTimes Then
'超过允许的登录次数,显示提示信息
MsgBox "你应经超过允许的登录验证次数!" & vbCr & "应用程序将结束!", vbCritical, "登录验证"
End
Else
'检查用户名和口令的合法性,并根据检验返回值执行相应的操作
Select Case check_password()
Case 0
MsgBox txtlog(0) & "不是系统用户" & "请检查用户名输入是否正确!", vbCritical, "登录验证"
txtlog(0).SetFocus
txtlog(0).SelStart = 0: txtlog(0).SelLength = Len(txtlog(0))
Case 1
MsgBox "口令错误,请重新输入!", vbCritical, "登录验证"
txtlog(1) = "": txtlog(1).SetFocus
Case 2
Unload Me
MsgBox " 登录成功,将启动系统管理程序!", vbInformation, "登录验证"
frmsysmain.Show '显示系统主窗体
Case Else
MsgBox "登录验证未正常完成!请重新运行登录程序," & vbCrLf & "如果仍不能登录,请报告系统管理员!", _
vbCritical, " 登录验证"
End Select
End If
End Sub
Private Function check_password() As Byte
On Error GoTo gperror
Dim objcn As New Connection
Dim objrs As New Recordset
Dim strCn As String, strsql As String
'建立数据库连接
strCn = "Provider=MSDASQL.1;Persist Security Info=false;" & "data source= 物管数据DSN"
objcn.connectionstring = strCn
objcn.ConnectionTimeout = 30
objcn.Open
'执行查询命令,获得用户登录口令
strsql = "select*from 系统用户 Where 用户名=" '&txtlog(0)&'""
Set objrs.ActiveConnection = objcn
objrs.Open (strsql)
If objrs.EOF Then
check_password = 0 '没有查询结果,表示该用户为非法用户
Else
If txtlog(1) <> Trim(objrs.Fields("口令")) Then
check_password = 1 '口令不正确
Else
check_password = 2 '口令正确
'保存用户信息
CurrentUserName = objrs.Fields("用户名")
CurrentUserPassword = objrs.Fields("口令")
CurrentUserStatus = objrs.Fields("身份")
End If
End If
'关闭数据库连接,释放对象
objcn.Close
Set objrs = Nothing
Set objcn = Nothing
Exit Function
gperror:
check_password = 225
End Function