在 VBA 项目中安全地存储密码

Lic*_*h4r 5 security vba

我在我的公司服务中建立了一个供不同人使用的文件。

每个工作表都受密码保护,所有用户条目都使用 VBA 用户表单处理。当用户修改数据时,所有工作表都受相同的密码和我的代码保护/取消保护工作表的保护。

问题是我在 VBA 项目中以明文形式存储密码以便调用该ActiveSheet.Protect password方法。VBA 项目也受此密码保护。

有没有一种安全的方法可以在 VBA 项目中存储该密码?

任何知道如何搜索的人都会找到破解该 VBA 项目密码并能够读取它的代码。

编辑 :

我想过在每次打开文件时通过添加一些随机性来计算一个新密码。这样就可以在不知道密码的情况下阅读代码。添加 msgbox 可以显示它,但只能在文件重新打开结束之前显示。问题是我无法使用该方法手动取消保护/保护工作表,因为我不知道密码。

小智 1

这应该可以解决问题。密码是smp2smp2,您将在运行时获得该密码GetPassword,但实际值不会存储在项目中。它使用代码 存储30555112012321187051111661144119,该代码将使用 转换为实际密码(人类可读)CreatePasswordFromCode。顺便说一句,我不知道如何轻松获取属于某个密码的代码。而且这样一来,它的长度始终是8个字符,没有更改的余地,除非你调整代码。我在别人的旧项目中找到了这个,不幸的是没有提到来源。

Option Explicit

Function GetPassword() As String

    'the password is stored as codes, so the real password is not stored in this project
    GetPassword = CreatePasswordFromCode("30555112012321187051111661144119")

End Function

Function CreatePasswordFromCode(ByVal pstrPasswordCode As String) As String
Dim intChar As Integer
Dim intCode As Integer
Dim arrintShifts(0 To 7) As Integer
Dim arrlngCharCode(0 To 7) As Long
Dim strMessage As String

    intChar = 0
    intCode = 0

    For intCode = 0 To 7
        'store -8 to -1 into 0-7
        arrintShifts(intCode) = intCode - 8
    Next intCode

    'the code is stored by using the number of the letter of the password in the 4th character.
    'the real code of the character is directly behind that.
    'so the code 30555112012321187051111661144119
    'has on position 3, 055, 5, 112, 0, 123, 2, 118, 7, 051, 1, 116, 6, 114 and 4, 119
    'so sorted this is 0, 123, 1, 116, 2, 118, 3, 055, 4, 119, 5, 112, 6, 114, 7, 051
    'then there is also the part where those charcode are shifted by adding -8 to -1 to them.
    'leading to the real charactercodes:
    '0, 123-8, 1, 116-7, 2, 118-6, 3, 055-5, 4, 119-4, 5, 112-3, 6, 114-2, 7, 051-1
    '0, 115, 1, 109, 2, 112, 3, 050, 4, 115, 5, 109, 6, 112, 7, 050
    For intChar = 0 To 7
        If Mid(pstrPasswordCode, 1, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 2, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 5, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 6, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 9, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 10, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 13, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 14, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 17, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 18, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 21, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 22, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 25, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 26, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 29, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 30, 3) + arrintShifts(intChar))
        End If
    Next intChar

    'by getting the charcodes of these values, you create the password
    CreatePasswordFromCode = Chr(arrlngCharCode(0)) & Chr(arrlngCharCode(1)) & Chr(arrlngCharCode(2)) & Chr(arrlngCharCode(3)) & Chr(arrlngCharCode(4)) & Chr(arrlngCharCode(5)) & Chr(arrlngCharCode(6)) & Chr(arrlngCharCode(7))

End Function
Run Code Online (Sandbox Code Playgroud)