sql - 当用户的 SQL Server 密码过期时，从 VBA 执行 sp_password(存储过程)

Question

我研究这个问题有一段时间了，但还是没能解决这个问题。我开发了一个前端(在 MS Access 中使用 VBA)，允许用户轻松输入、查看 SQL Server 中存储的数据并与之交互。

一切运行良好，只是用户的密码每 60 天左右就会过期，而且他们无法通过 MS Access 前端更新密码，而且我厌倦了手动更新密码。

我创建了一些代码，允许用户在密码尚未过期的情况下更改密码，但是一旦密码过期，我们就不能再在后端手动更改密码了。

我认为问题在于，当密码尚未过期时，用户仍然可以成功连接到 SQL Server 并执行将更改其密码的存储过程。但是，一旦密码过期，他们就无法再实际连接到服务器来执行存储过程来更改密码。 关于如何解决这个问题有什么想法吗？所有密码都将很快过期，我不想手动更新所有密码。

这是我正在处理的代码示例。它充满了垃圾并且不起作用，但我认为它可能是在正确的方向上。

Option Compare Database

Private Sub ChangePWbutton_Click()
On Error GoTo ErrHandler

Dim cnComments As New ADODB.Connection
Dim strCS As String
Dim P As String
Dim Rsx As ADODB.Recordset

'Set up the connection string
strCS = "Provider=SQLOLEDB;" _
     & "Server=IPaddressHere\SQL_2005;" _
     & "Database=" + DBselect.Value + ";" _
     & "User ID=" + Uname.Value + ";" _
     & "Password=" + pWord.Value + ";" _
     & "MARS Connection=True;"

    cnComments.Open strCS

    If cnComments.State = adStateOpen Then
    MsgBox "it is open Place 1"
    End If

'P = "sp_password '" & pWord.Value & "', '" & NewPW.Value & "', '" & Uname.Value & "'"
'Set Rsx = cnComments.Execute(P)

ErrHandler:
Select Case Err.Number

     Case -2147467259
        If cnComments.Errors.Count > 1 Then
            Select Case cnComments.Errors(1).NativeError

                Case 18463 To 18468, 18487 To 18488

                    MsgBox "The password must be changed. Password expired."
                    If cnComments.State = adStateOpen Then
                    MsgBox "it is open place 2"
                    End If

                        'cnComments.Open strCS, bragado_l, Accenture1*
                        P = "sp_password '" & pWord.Value & "', '" & NewPW.Value & "', '" & Uname.Value & "'"
                        Set Rsx = cnComments.Execute(P)



                    'strNewPassword = ChangePassword() 'a function you create
                    'If Len(strNewPassword) Then
                        'Con.ConnectionString = strConnectionString & ";User ID=" & strUser & ";Password=" & strNewPassword & ";Old Password=" & strPassword
                        'Resume ExitProc
                    'Else
                       ' QuitProgram
                    'End If

            End Select
        End If
    Case Else
        VBA.MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
End Select
'Resume ExitProc
'Resume

End Sub

Answer 1

看起来您正在使用 ADO，因此您可以使用类似的东西。它使用参数来防止sql注入(inject)。

Function changePassword()

    Dim username As String, yourThreshold As Integer
    username = "testUser"

    Dim conn As ADODB.Connection
    Dim expiresInDays As Integer

    Set conn = GetProjectConnection
    expiresInDays = DaysUntilExpiration(conn, username)

    Dim oldPassword As String, newPassword As String
    oldPassword = "oldpassword123"
    newPassword = "newpassword321"

    If expiresInDays <= yourThreshold Then
        ResetPassword conn, username, oldPassword, newPassword
    End If

End Function

Function ResetPassword(conn As ADODB.Connection, username As String, oldPassword As String, newPassword As String)
    Dim cmd As ADODB.Command

    Set cmd = New ADODB.Command
    cmd.ActiveConnection = conn
    cmd.CommandType = CommandTypeEnum.adCmdStoredProc
    cmd.CommandText = "sp_password"
    cmd.Parameters.Append cmd.CreateParameter("@old", adVarWChar, adParamInput, 128, oldPassword)
    cmd.Parameters.Append cmd.CreateParameter("@new", adVarWChar, adParamInput, 128, newPassword)
    cmd.Parameters.Append cmd.CreateParameter("@loginname", adVarWChar, adParamInput, 128, username)

    Dim rs As New ADODB.Recordset
    cmd.Execute
    cmd.Parameters.Refresh
    ResetPassword = cmd.Parameters("@RETURN_VALUE").Value

End Function

Function DaysUntilExpiration(conn As ADODB.Connection, username As String) As Integer
    Dim cmd As ADODB.Command

    Set cmd = New ADODB.Command
    cmd.ActiveConnection = conn
    cmd.CommandType = CommandTypeEnum.adCmdText
    cmd.CommandText = "SELECT [expiresInDays] = LOGINPROPERTY(@pUsername, 'DaysUntilExpiration')"
    cmd.Parameters.Append cmd.CreateParameter("@pUsername", adVarWChar, adParamInput, 255, username)
    Dim rs As New ADODB.Recordset
    rs.Open cmd
    DaysUntilExpiration = rs("expiresInDays").Value

End Function