我在我公司的一项服务中建立了一个供不同人员使用的文件。
每张工作表均受密码保护,所有用户条目均通过 VBA 用户表单处理。所有工作表均受相同密码保护,当用户修改数据时,我的代码会保护/取消保护工作表。
问题是我在 VBA 项目中以明文形式存储密码,以便调用
ActiveSheet.Protect password
方法。 VBA 项目也受此密码保护。
有没有一种安全的方法来在 VBA 项目中存储该密码?
任何懂得如何搜索的人都会找到破解该 VBA 项目密码的代码并能够读取它。
编辑:
我曾想过通过在文件中添加一些随机性来计算每次打开文件时的新密码。这样人们就可以在不知道密码的情况下读取代码。添加消息框可能会显示它,但只能在文件重新打开之前显示。问题是我无法使用该方法手动取消保护/保护工作表,因为我不知道密码。
总结评论中的有用信息:
结论:没有办法在 Excel VBA 中安全地存储密码
这应该可以解决问题。密码是
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
修改了代码以使用最多 99 个字符。添加了密码生成器。
但是:这一切只是对真实密码的混淆。
Function CreatePasswordFromCode(ByVal pstrPasswordCode As String) As String
' Original Code https://stackoverflow.com/questions/47990187/securely-store-password-in-a-vba-project?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
尽管它不安全,但您可以将密码存储在 xlm 密钥中,以防止代码受到影响。
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
这并不安全,但会使您的纯文本密码远离代码和工作表。