logo标签列表

在VBA项目中安全存储密码

vbasecurity
6
我创建了一个文件，用于我公司服务中多个人员使用。
每个表格都受到密码保护，所有用户的输入都由 VBA 用户表单处理。 所有表格都由相同的密码保护，我的代码在用户修改数据时保护/取消保护表格。
问题是，我将密码以明文形式存储在 VBA 项目中，以调用 ActiveSheet.Protect password 方法。VBA 项目也受到此密码的保护。
是否存在一种安全的方法来存储 VBA 项目中的密码？
任何知道如何搜索的人都会找到破解该 VBA 项目密码的代码，并能够阅读它。
编辑：
我想过每次打开文件时通过添加一些随机性来计算新密码。这样，即使不知道密码，也可以读取代码。 添加 msgbox 可以显示密码，但只有在重新打开文件之前有效。 问题是，我不能使用该方法手动取消保护/保护表格，因为我不会知道密码。
我看到了很多关于破解密码的内容，但没看到存储密码的。我正在寻求一种实现这一点的方法，这对我来说不像是基于个人意见的。我知道他们可能会破解它，但我不希望他们找到实际的密码，因为我必须保持“可读性”，以便我的同事能够使用它... :/ - Lich4r
4
将密码存储在文件本身中有点像把房门钥匙放在门垫下面。这与没有密码几乎没有区别！以下是有关混淆和密码存储的一些有用信息。 - ashleedawg
虽然这篇文章很有趣，但并没有帮助。我可以像处理个人密码一样将这些工作簿密码存储在密码管理器中，但这并不能解决任何“破解”VBA项目的人都能够读取它的问题。我想用实际密码的哈希值来保护工作表，但我不知道如何在代码中计算出哈希值而不让密码以明文形式出现。 - Lich4r
1
看起来 ActiveSheet.Protect 接受明文密码作为其参数，因此在 Excel 表格的代码中保存此密码的唯一方法是尝试从 不同的 Excel / VBA 文件中保护它们。但基本上，Excel 不安全。如果您需要此应用程序具有安全性，则需要在更安全的平台上构建它。 - Nick.McDermaid
1
移除VBA密码非常简单：https://dev59.com/LnNA5IYBdhLWcg3wSrqa 因此，简单的答案是：没有安全的方法来保护VBA项目。 - Wernfried Domscheit
我不想保护VBA项目。我希望任何破解它的人都无法知道使用了哪个密码。这样我就知道如果有什么被修改了，那就意味着该项目已经被破解，而不是密码已经被泄露。 - Lich4r
4个回答
3

从评论中总结有用信息:

  • 如果你的代码可以访问密码（即使是直接访问或通过混淆），任何访问代码的人都可以访问密码
  • Excel VBA 的密码保护非常薄弱，破解它是一件微不足道的工作

结论: 在Excel VBA中没有安全地存储密码的方法

1

修改了代码，支持最多99个字符。添加了密码生成器。

但是仍然需要注意：这只是对真实密码的混淆处理。

Function CreatePasswordFromCode(ByVal pstrPasswordCode As String) As String
' Original Code https://dev59.com/-afja4cB1Zd3GeqP1MuD?utm_medium=organic&utm_source=google_rich_qa&utm_campaign=google_rich_qa
' Modified to extend password length
' Modifications free to use
Dim codeLen As Integer

Dim intChar As Integer
Dim intCode As Integer
Dim arrintShifts() As Integer
Dim arrlngCharCode() As Long
Dim icp As Integer

    ' Initialise Arrays
    icp = IIf(Right(pstrPasswordCode, 1) Mod 2 = 0, 5, 4)
    pstrPasswordCode = Left(pstrPasswordCode, Len(pstrPasswordCode) - IIf(Right(pstrPasswordCode, 1) Mod 2 = 0, 1, 1))
    codeLen = Len(pstrPasswordCode) / icp - 1 ' Array Index starts with 0
    ReDim arrintShifts(codeLen)
    ReDim arrlngCharCode(codeLen)

    intChar = 0
    intCode = 0

    For intCode = 0 To codeLen
        'store -8 to -1 into 0-7
        arrintShifts(intCode) = intCode - (codeLen + 1)
    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 codeLen
        For intCode = 0 To codeLen
            If CInt(Mid(pstrPasswordCode, intCode * icp + 1, icp - 3)) = intChar Then
                arrlngCharCode(intChar) = (Mid(pstrPasswordCode, (intCode + 1) * icp - 2, 3) + arrintShifts(intChar))
                Exit For
            End If
        Next intCode
    Next intChar

    'by getting the charcodes of these values, you create the password
    CreatePasswordFromCode = ""
    For intChar = 0 To codeLen
        CreatePasswordFromCode = CreatePasswordFromCode & Chr(arrlngCharCode(intChar))
    Next intChar

End Function

Function CreateCodeFromPassword(ByVal pstrPasswordCode As String) As String
' Generator free to use
Dim pwLen As Integer
Dim scp As String   ' String Code Position, for formatting "0" or "00"
Dim icp As Integer  ' marker if pwLen < 10 or > 10
Dim intCode As Integer
Dim arrintShifts() As Integer
Dim arrlngCharCode() As Long
Dim pw() As String

Dim Temp As Variant
Dim arnd() As Variant
Dim irnd As Variant

    Randomize

    ' Initialise Arrays
    pwLen = Len(pstrPasswordCode) - 1 ' Array Index starts with 0
    scp = IIf(pwLen < 10, "0", "00")
    ' Create odd/even marker if we have 1 (odd) or 2 (even) byte index digits (scp), values between 0 and 9
    icp = IIf(pwLen < 10, Int(Rnd() * 5 + 1) * 2 - 1, Int(Rnd() * 5 + 1) * 2)

    ReDim arrintShifts(pwLen)
    ReDim arrlngCharCode(pwLen)
    ReDim pw(pwLen)
    ReDim arnd(pwLen)

    For intCode = 0 To pwLen
        arnd(intCode) = intCode
    Next intCode

    ' randomize the indizes to bring the code into a random order
    For intCode = LBound(arnd) To UBound(arnd)
        irnd = CLng(((UBound(arnd) - intCode) * Rnd) + intCode)
        If intCode <> irnd Then
            Temp = arnd(intCode)
            arnd(intCode) = arnd(irnd)
            arnd(irnd) = Temp
        End If
    Next intCode

    'by getting the charcodes of these values, you create the password
    For intCode = 0 To pwLen
        'get characters
        pw(intCode) = Mid(pstrPasswordCode, intCode + 1, 1)
        'and store -8 to -1 into 0-7 (for additional obfuscation)
        arrintShifts(intCode) = intCode - (pwLen + 1)
    Next intCode

    ' Search for the random index and throw the shifted code at this position
    For intCode = 0 To pwLen
        arrlngCharCode(Application.Match(intCode, arnd, False) - 1) = AscB(pw(intCode)) - arrintShifts(intCode)
    Next intCode

    ' Chain All Codes, combination of arnd(intcode) and arrlngCharCode(intcode) gives the random order
    CreateCodeFromPassword = ""
    For intCode = 0 To pwLen
        CreateCodeFromPassword = CreateCodeFromPassword & Format(arnd(intCode), scp) & Format(arrlngCharCode(intCode), "000")
    Next intCode
    CreateCodeFromPassword = CreateCodeFromPassword & icp

End Function

混淆版本

'VBA code protection using: www.excel-pratique.com/en/vba_tricks/vba-obfuscator.php
Function CreatePasswordFromCode(ByVal z4891679d877f1da36647b21d6197fbfd As String) As String
Dim b2da54ddb60c93bf346493d7e08bc6d08 As Integer
Dim bf56f94eb6ed9a658e82e88591237324d As Integer
Dim bec732ae8e18b7b2ff2e9ccd058f3e8fc As Integer
Dim m06993036154505accc9ce092bdb57b17() As Integer
Dim b8026f9f8f7fe86372be0799d8c9c6691() As Long
Dim q24471047c7a6e466b78de3c6ae66f20f As String
Dim t5f443e88a552a3f943275f985dde03ca As Integer
t5f443e88a552a3f943275f985dde03ca = IIf(Right(z4891679d877f1da36647b21d6197fbfd, 1) Mod 2 = 0, 5, 4)
z4891679d877f1da36647b21d6197fbfd = Left(z4891679d877f1da36647b21d6197fbfd, Len(z4891679d877f1da36647b21d6197fbfd) - IIf(Right(z4891679d877f1da36647b21d6197fbfd, 1) Mod 2 = 0, 1, 1))
b2da54ddb60c93bf346493d7e08bc6d08 = Len(z4891679d877f1da36647b21d6197fbfd) / t5f443e88a552a3f943275f985dde03ca - 1
ReDim m06993036154505accc9ce092bdb57b17(b2da54ddb60c93bf346493d7e08bc6d08)
ReDim b8026f9f8f7fe86372be0799d8c9c6691(b2da54ddb60c93bf346493d7e08bc6d08)
bf56f94eb6ed9a658e82e88591237324d = 0
bec732ae8e18b7b2ff2e9ccd058f3e8fc = 0
For bec732ae8e18b7b2ff2e9ccd058f3e8fc = 0 To b2da54ddb60c93bf346493d7e08bc6d08
m06993036154505accc9ce092bdb57b17(bec732ae8e18b7b2ff2e9ccd058f3e8fc) = bec732ae8e18b7b2ff2e9ccd058f3e8fc - (b2da54ddb60c93bf346493d7e08bc6d08 + 1)
Next bec732ae8e18b7b2ff2e9ccd058f3e8fc
For bf56f94eb6ed9a658e82e88591237324d = 0 To b2da54ddb60c93bf346493d7e08bc6d08
For bec732ae8e18b7b2ff2e9ccd058f3e8fc = 0 To b2da54ddb60c93bf346493d7e08bc6d08
If CInt(Mid(z4891679d877f1da36647b21d6197fbfd, bec732ae8e18b7b2ff2e9ccd058f3e8fc * t5f443e88a552a3f943275f985dde03ca + 1, t5f443e88a552a3f943275f985dde03ca - 3)) = bf56f94eb6ed9a658e82e88591237324d Then
b8026f9f8f7fe86372be0799d8c9c6691(bf56f94eb6ed9a658e82e88591237324d) = (Mid(z4891679d877f1da36647b21d6197fbfd, (bec732ae8e18b7b2ff2e9ccd058f3e8fc + 1) * t5f443e88a552a3f943275f985dde03ca - 2, 3) + m06993036154505accc9ce092bdb57b17(bf56f94eb6ed9a658e82e88591237324d))
Exit For
End If
Next bec732ae8e18b7b2ff2e9ccd058f3e8fc
Next bf56f94eb6ed9a658e82e88591237324d
CreatePasswordFromCode = ""
For bf56f94eb6ed9a658e82e88591237324d = 0 To b2da54ddb60c93bf346493d7e08bc6d08
CreatePasswordFromCode = CreatePasswordFromCode & Chr(b8026f9f8f7fe86372be0799d8c9c6691(bf56f94eb6ed9a658e82e88591237324d))
Next bf56f94eb6ed9a658e82e88591237324d
End Function
Function CreateCodeFromPassword(ByVal z4891679d877f1da36647b21d6197fbfd As String) As String
Dim qe564274d6cab7b91a3393ef092dac78f As Integer
Dim b330c8da5472f3c36b801671ef5a54797 As String
Dim t5f443e88a552a3f943275f985dde03ca As Integer
Dim bec732ae8e18b7b2ff2e9ccd058f3e8fc As Integer
Dim m06993036154505accc9ce092bdb57b17() As Integer
Dim b8026f9f8f7fe86372be0799d8c9c6691() As Long
Dim b343223dcae485b35af2792c7dd91f92b() As String
Dim e0d4cf763c9da42470a729a29b30d7d50 As Variant
Dim b41d8f2e79c0e09113beb7629aa0d8c48() As Variant
Dim b42a57d0c121b9fe34a74143aa279157c As Variant
Randomize
qe564274d6cab7b91a3393ef092dac78f = Len(z4891679d877f1da36647b21d6197fbfd) - 1
b330c8da5472f3c36b801671ef5a54797 = IIf(qe564274d6cab7b91a3393ef092dac78f < 10, "0", "00")
t5f443e88a552a3f943275f985dde03ca = IIf(qe564274d6cab7b91a3393ef092dac78f < 10, Int(Rnd() * 5 + 1) * 2 - 1, Int(Rnd() * 5 + 1) * 2)
ReDim m06993036154505accc9ce092bdb57b17(qe564274d6cab7b91a3393ef092dac78f)
ReDim b8026f9f8f7fe86372be0799d8c9c6691(qe564274d6cab7b91a3393ef092dac78f)
ReDim b343223dcae485b35af2792c7dd91f92b(qe564274d6cab7b91a3393ef092dac78f)
ReDim b41d8f2e79c0e09113beb7629aa0d8c48(qe564274d6cab7b91a3393ef092dac78f)
For bec732ae8e18b7b2ff2e9ccd058f3e8fc = 0 To qe564274d6cab7b91a3393ef092dac78f
b41d8f2e79c0e09113beb7629aa0d8c48(bec732ae8e18b7b2ff2e9ccd058f3e8fc) = bec732ae8e18b7b2ff2e9ccd058f3e8fc
Next bec732ae8e18b7b2ff2e9ccd058f3e8fc
For bec732ae8e18b7b2ff2e9ccd058f3e8fc = LBound(b41d8f2e79c0e09113beb7629aa0d8c48) To UBound(b41d8f2e79c0e09113beb7629aa0d8c48)
b42a57d0c121b9fe34a74143aa279157c = CLng(((UBound(b41d8f2e79c0e09113beb7629aa0d8c48) - bec732ae8e18b7b2ff2e9ccd058f3e8fc) * Rnd) + bec732ae8e18b7b2ff2e9ccd058f3e8fc)
If bec732ae8e18b7b2ff2e9ccd058f3e8fc <> b42a57d0c121b9fe34a74143aa279157c Then
e0d4cf763c9da42470a729a29b30d7d50 = b41d8f2e79c0e09113beb7629aa0d8c48(bec732ae8e18b7b2ff2e9ccd058f3e8fc)
b41d8f2e79c0e09113beb7629aa0d8c48(bec732ae8e18b7b2ff2e9ccd058f3e8fc) = b41d8f2e79c0e09113beb7629aa0d8c48(b42a57d0c121b9fe34a74143aa279157c)
b41d8f2e79c0e09113beb7629aa0d8c48(b42a57d0c121b9fe34a74143aa279157c) = e0d4cf763c9da42470a729a29b30d7d50
End If
Next bec732ae8e18b7b2ff2e9ccd058f3e8fc
For bec732ae8e18b7b2ff2e9ccd058f3e8fc = 0 To qe564274d6cab7b91a3393ef092dac78f
b343223dcae485b35af2792c7dd91f92b(bec732ae8e18b7b2ff2e9ccd058f3e8fc) = Mid(z4891679d877f1da36647b21d6197fbfd, bec732ae8e18b7b2ff2e9ccd058f3e8fc + 1, 1)
m06993036154505accc9ce092bdb57b17(bec732ae8e18b7b2ff2e9ccd058f3e8fc) = bec732ae8e18b7b2ff2e9ccd058f3e8fc - (qe564274d6cab7b91a3393ef092dac78f + 1)
Next bec732ae8e18b7b2ff2e9ccd058f3e8fc
For bec732ae8e18b7b2ff2e9ccd058f3e8fc = 0 To qe564274d6cab7b91a3393ef092dac78f
b8026f9f8f7fe86372be0799d8c9c6691(Application.Match(bec732ae8e18b7b2ff2e9ccd058f3e8fc, b41d8f2e79c0e09113beb7629aa0d8c48, False) - 1) = AscB(b343223dcae485b35af2792c7dd91f92b(bec732ae8e18b7b2ff2e9ccd058f3e8fc)) - m06993036154505accc9ce092bdb57b17(bec732ae8e18b7b2ff2e9ccd058f3e8fc)
Next bec732ae8e18b7b2ff2e9ccd058f3e8fc
CreateCodeFromPassword = ""
For bec732ae8e18b7b2ff2e9ccd058f3e8fc = 0 To qe564274d6cab7b91a3393ef092dac78f
CreateCodeFromPassword = CreateCodeFromPassword & Format(b41d8f2e79c0e09113beb7629aa0d8c48(bec732ae8e18b7b2ff2e9ccd058f3e8fc), b330c8da5472f3c36b801671ef5a54797) & Format(b8026f9f8f7fe86372be0799d8c9c6691(bec732ae8e18b7b2ff2e9ccd058f3e8fc), "000")
Next bec732ae8e18b7b2ff2e9ccd058f3e8fc
CreateCodeFromPassword = CreateCodeFromPassword & t5f443e88a552a3f943275f985dde03ca
End Function
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
0
虽然这样做并不安全，但你可以将密码存储在一个XML密钥中，从而避免将其直接放在代码中。
Sub guardaRuta(etiqueta As String, texto As String)
    Dim objXMLPart As CustomXMLPart
    'borra las rutas que hubiese
    For Each objXMLPart In ThisWorkbook.CustomXMLParts
        If objXMLPart.DocumentElement.BaseName = etiqueta Then
            objXMLPart.Delete
            Exit For
        End If
    Next objXMLPart
    'añade una ruta
    Set objXMLPart = ThisWorkbook.CustomXMLParts.Add("<" & etiqueta & ">" & texto & "</" & etiqueta & ">")

End Sub

Function recuperaRuta(texto As String) As String
    Dim txt As String
    Dim objXMLPart As CustomXMLPart
    For Each objXMLPart In ThisWorkbook.CustomXMLParts
        If objXMLPart.DocumentElement.BaseName = texto Then
            txt = objXMLPart.DocumentElement.Text
            Exit For
        End If
    Next objXMLPart
    recuperaRuta = txt
End Function

这个方法并不安全，但可以将您的明文密码从代码和工作表中移除。
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接