回 帖 发 新 帖 刷新版面

主题:关于小区物业管理系统软件

这是一个小区物业管理系统中系统用户管理的代码,在调试时弹出一个框,“编译错误无效使用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


回复列表 (共1个回复)

沙发

出错位置呢?
是在Dim objcopy As New Recordset吗?
如果是,去掉new。
如果不是,我也不知道怎么办。

我来回复

您尚未登录,请登录后再回复。点此登录或注册