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

你可能感兴趣的:(Office)