破解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