破解OfficeVBA密码的方法

提示：扫一扫查出行
【扫一扫了解最新限行尾号】
复制提示

我自己找到一个office的VBA加密方法，然后再去找一个方法来破解密码，好像有点自相矛盾啊。

如果excel文件是xls或xlm格式（如果不是请转化成此种方法），则可使用以下代码：

1. '移除VBA编码保护
2. Sub MoveProtect()
3. Dim FileName As String
4. FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlsx & *.xlsm）,*.xls;*.xla ;*.xlsx ; *.xlsm", , "VBA破解")
5. If FileName = CStr(False) Then
6. Exit Sub
7. Else
8. VBAPassword FileName, False
9. End If
10. End Sub
11. '设置VBA编码保护
12. Sub SetProtect()
13. Dim FileName As String
14. FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlsx & *.xlsm）,*.xls;*.xla ;*.xlsx ; *.xlsm", , "VBA破解")
15. If FileName = CStr(False) Then
16. Exit Sub
17. Else
18. VBAPassword FileName, True
19. End If
20. End Sub
21. Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
22. If Dir(FileName) = "" Then
23. Exit Function
24. Else
25. FileCopy FileName, FileName & ".bak"
26. End If
27.  
28. Dim GetData As String * 5
29. Open FileName For Binary As #1
30. Dim CMGs As Long
31. Dim DPBo As Long
32. For i = 1 To LOF(1)
33. Get #1, i, GetData
34. If GetData = "CMG=""" Then CMGs = i
35. If GetData = "[Host" Then DPBo = i - 2: Exit For
36. Next
37.  
38. If CMGs = 0 Then
39. MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
40. Exit Function
41. End If
42.  
43. If Protect = False Then
44. Dim St As String * 2
45. Dim s20 As String * 1
46.  
47. '取得一个0D0A十六进制字串
48. Get #1, CMGs - 2, St
49.  
50. '取得一个20十六制字串
51. Get #1, DPBo + 16, s20
52.  
53. '替换加密部份机码
54. For i = CMGs To DPBo Step 2
55. Put #1, i, St
56. Next
57.  
58. '加入不配对符号
59. If (DPBo - CMGs) Mod 2 <> 0 Then
60. Put #1, DPBo + 1, s20
61. End If
62. MsgBox "文件解密成功......", 32, "提示"
63. Else
64. Dim MMs As String * 5
65. MMs = "DPB="""
66. Put #1, CMGs, MMs
67. MsgBox "对文件特殊加密成功......", 32, "提示"
68. End If
69. Close #1
70. End Function