如何使用代码加密访问密码？

Question

我创建了一个部署访问文件，用于部署我的生产访问文件。这将表重新链接到生产SQL服务器，包括禁用Shift的使用，添加新的版本号...我还需要使用密码加密生产访问文件。这应该使用我的部署访问文件中的代码来完成，但我找不到这样做的方法。有什么想法吗？谢谢。

Answer 1

尝试此函数：

Public Function SetDatabasePassword(strDatabasePath As String, Optional pNewPassword As Variant, Optional pOldPassword As Variant) As String
    On Error GoTo SetDatabasePassword_Error
    DoCmd.Hourglass True
    Const cProvider = "Microsoft.ACE.OLEDB.12.0"
    Dim cnn As ADODB.Connection
    Dim strNewPassword As String
    Dim strOldPassword As String
    Dim strCommand As String
    Dim strResult As String

    ' If a password is not specified (IsMissing), ' the string is "NULL" WITHOUT the brackets
    If IsMissing(pNewPassword) Then
        strNewPassword = "NULL"
    Else
        strNewPassword = "[" & pNewPassword & "]"
    End If
    
    If IsMissing(pOldPassword) Then
        strOldPassword = "NULL"
    Else
        strOldPassword = "[" & pOldPassword & "]"
    End If
    
    strCommand = "ALTER DATABASE PASSWORD " & strNewPassword & " " & strOldPassword & ";"
    
    Set cnn = New ADODB.Connection
    With cnn
        .Mode = adModeShareExclusive
        .Provider = cProvider
        If Not IsMissing(pOldPassword) Then
            .Properties("Jet OLEDB:Database Password") = pOldPassword
        End If
        .Open "Data Source=" & strDatabasePath & ";"
        .Execute strCommand
    End With
    strResult = "Password Set"
ExitProc_:
    On Error Resume Next
    cnn.Close
    Set cnn = Nothing
    SetDatabasePassword = strResult

    DoCmd.Hourglass False
    Exit Function

SetDatabasePassword_Error:
    DoCmd.Hourglass False
    If Err.Number = -2147467259 Then
        strResult = "An error occured"
    ElseIf Err.Number = -2147217843 Then
        strResult = "Invalid password"
    Else
        strResult = Err.Number & " " & Err.Description
    End If
    Resume ExitProc_
    Resume ' use for debugging
End Function