VBA工程/宏文件加密解密

常规加密：在整个工程属性，设置保护密码

解密：

• 一、将excel文件改后缀为 zip，将里面的 xl 目录中的【vbaProject.bin】拷贝出来，这是个二进制文件。
• 用二进制编辑器Hex Editor Neo 打开它，搜索【DPB】,将【DPB】改为【DPX】保存
• 放回去替换原来的，记得把原来的备份一下。
• 将zip改回xlsm。打开后查看工程属性，取消勾选密码即可！
• 参考博客：https://blog.csdn.net/qq_14815199/article/details/119457181
• 二、利用另一个VBA脚本解密，直接将excel文件以以二进制打开，替换其中的机码
• 查找其中的CMG 和 [Host] 的位置，将CMG 至 Host中间的部分转为十六进制符号，保存
• 加密的时候 在 CMG后加上DPB= 即可 。添加的时候必须是十六进制字符
• 详细脚本如下：

'移除VBA编码保护
Sub MoveProtect()
    Dim FileName As String
    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
    If FileName = CStr(False) Then
       Exit Sub
    Else
       VBAPassword FileName, False
    End If
End Sub

'设置VBA编码保护
Sub SetProtect()
    Dim FileName As String
    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
    If FileName = CStr(False) Then
       Exit Sub
    Else
       VBAPassword FileName, True
    End If
End Sub

Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
      If Dir(FileName) = "" Then
         Exit Function
      Else
         FileCopy FileName, FileName & ".bak"
      End If

      Dim GetData As String * 5
      Open FileName For Binary As #1
      Dim CMGs As Long
      Dim DPBo As Long
      For i = 1 To LOF(1)
          Get #1, i, GetData
          If GetData = "CMG=""" Then CMGs = i
          If GetData = "[Host" Then DPBo = i - 2: Exit For
      Next
      If CMGs = 0 Then
         MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
         Exit Function
      End If
      If Protect = False Then
         Dim St As String * 2
         Dim s20 As String * 1
         '取得一个0D0A十六进制字串
         Get #1, CMGs - 2, St
         '取得一个20十六制字串
         Get #1, DPBo + 16, s20
         '替换加密部份机码
         For i = CMGs To DPBo Step 2
             Put #1, i, St
         Next
         '加入不配对符号
         If (DPBo - CMGs) Mod 2 <> 0 Then
            Put #1, DPBo + 1, s20
         End If
         MsgBox "文件解密成功......", 32, "提示"
      Else
         Dim MMs As String * 5
         MMs = "DPB="""
         Put #1, CMGs, MMs
         MsgBox "对文件特殊加密成功......", 32, "提示"
      End If
      Close #1
End Function