当用户的 SQL 服务器密码过期时从 VBA 执行sp_password(存储过程)

Question

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

一切都很好，除了用户的密码每60天左右过期，他们没有办法通过MS Access前端更新他们的密码，我厌倦了手动更新密码。

我已经创建了一些代码，允许用户更改他们的密码，如果密码还没有过期，但是一旦密码过期，我们是SOL，必须在后端手动更改它。

我认为问题在于当密码没有过期时，用户仍然可以成功地连接到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=IPaddressHereSQL_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注入。

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