抢分啦 ＶＢ 登陆问题

Question

Private Sub cmdOK_Click()
Dim chguser As New ADODB.Recordset
Dim dbstr As String
If Text_oldpws.Text = "" Then
MsgBox "请输入密码"
Exit Sub
End If
If Text_newpws.Text = "" Then
MsgBox "密码不能为空"
Exit Sub
End If
If Text_newpws2.Text = "" Then
MsgBox "请再次输入密码"
End If
If Text_newpws.Text <> Text_newpws2.Text Then
MsgBox "再次密码不一致!"
End Ifdbstr = "select * from useinfo where usename='"
dbstr = dbstr & Replace(usernow.id, "'", "''") & "'"
chguser.open dbstr, conn, adOpenStatic, adLockBatchOptimistic
chguser.MoveFirst
'检验旧密码
If Trim(Text_oldpws.Text) = chguser.fields("password").Value Then
chguser.fields("password").Value = Text_newpws.Text
Else
MsgBox "原密码错误!"
End If
chguser.Update
chguser.Close
MsgBox "修改成功"调试时显示成功，但是数据好像不能更新到数据库里，请高手更正下错误在那里．
我用的是ＡＣＣＥＳＳ数据库

Answer 1

adLockBatchOptimistic：選項改為adLockPessimistic試試。
因為設置adLockBatchOptimistic時，要使用chguser.UpdateBatch才更新。

Answer 2

dbstr = "select * from useinfo where usename='"
dbstr = dbstr & Replace(usernow.id, "'", "''") & "'"
改成
dbstr = "select * from useinfo where usename='" & usernow.id & "'"

Answer 3

'检验旧密码
If Trim(Text_oldpws.Text) = chguser.fields("password").Value Then
chguser.fields("password").Value = Text_newpws.Textchguser.update '加上这句，就OK了Else
MsgBox "原密码错误!"
End If
chguser.Update
chguser.Close
MsgBox "修改成功"

Answer 4

可能有两处错误：
1、
dbstr = "select * from useinfo where usename='"
dbstr = dbstr & Replace(usernow.id, "'", "''") & "'"
确认一下是userinfo表中的usename字段和usernow.id对应吗？是不是应该是id字段和usernow.id对应或者usename字段和usernow.usename对应，认真检查一下。2、
If Trim(Text_oldpws.Text) = chguser.fields("password").Value Then
chguser.fields("password").Value = Text_newpws.Text
Else
MsgBox "原密码错误!"
End If
chguser.Update
chguser.Close
MsgBox "修改成功"
这里逻辑有问题，你这里即便输入的原密码不正确也会去更新数据库，虽然最终的结果并没有修改数据库里的内容但是会影响系统的性能，而且如果原密码输错会出现两次提示，建议改成：
If Trim(Text_oldpws.Text) = chguser.fields("password").Value Then
chguser.fields("password").Value = Text_newpws.Text
chguser.Update
MsgBox "修改成功"
Else
MsgBox "原密码错误!"
End If
chguser.Close

Answer 5

修改了一下你的程序
Private Sub cmdOK_Click()
    Dim chguser As New ADODB.Recordset
    Dim dbstr As String
    
    If Text_oldpws.Text = "" Then
        MsgBox "?请输入密码"
        Exit Sub
    End If
    
    If Text_newpws.Text = "" Then
        MsgBox "密码不能为空"
        Exit Sub
    End If
    
    If Text_newpws2.Text = "" Then
        MsgBox "?请再次输入密码"
        Exit Sub
    End If
    
    If Text_newpws.Text <> Text_newpws2.Text Then
        MsgBox "再次密码不一致!"
        Exit Sub
    End If
    
    dbstr = ""
    dbstr = dbstr & "select * " & vbCrLf
    dbstr = dbstr & "  from useinfo " & vbCrLf
    dbstr = dbstr & " where usename='" & Replace(usernow.id, "'", "''") & "'"
    
    chguser.open dbstr, conn, adOpenStatic, adLockPessimistic
    chguser.MoveFirst
    
    
    '检验旧密码
    If Trim(Text_oldpws.Text) = chguser.fields("password").Value Then
        chguser.fields("password").Value = Text_newpws.Text
        MsgBox "修改成功"
    Else
        MsgBox "原密码错误!"
    End If
    
    chguser.Update
    chguser.Close
    
    End Sub

Answer 6

Private Sub cmdOK_Click()
    Dim chguser As New ADODB.Recordset
    Dim dbstr As String
    
    If Text_oldpws.Text = "" Then
        MsgBox "?请输入密码"
        Exit Sub
    End If
    
    If Text_newpws.Text = "" Then
        MsgBox "密码不能为空"
        Exit Sub
    End If
    
    If Text_newpws2.Text = "" Then
        MsgBox "?请再次输入密码"
        Exit Sub
    End If
    
    If Text_newpws.Text <> Text_newpws2.Text Then
        MsgBox "再次密码不一致!"
        Exit Sub
    End If
    
    dbstr = ""
    dbstr = dbstr & "select * " & vbCrLf
    dbstr = dbstr & "  from useinfo " & vbCrLf
    dbstr = dbstr & " where usename='" & Replace(usernow.id, "'", "''") & "'"
    
    chguser.open dbstr, conn, adOpenStatic, adLockPessimistic
    chguser.MoveFirst
    
    
    '检验旧密码
    If Trim(Text_oldpws.Text) = chguser.fields("password").Value Then
        chguser.fields("password").Value = Text_newpws.Text
        MsgBox "修改成功"
    Else
        MsgBox "原密码错误!"
    End If
    
    chguser.Update
    chguser.Close
    
    End Sub