ExcelVBA工程密码破解程序

1、ExcelVBA工程密码破解程序2008-08-29 21:06新建一个Excel工作簿,Alt+F11 打开VBA编辑器,新建一个模块 ,复制以下代码,注意如提示变量未定义,则把Option Explicit行删除即可,经测试已经通过.'移除VBA编码保护Sub MoveProtect()    Dim FileName As String    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla",

2、 , "VBA破解")    If FileName = CStr(False) Then       Exit Sub    Else       VBAPassword FileName, False    End IfEnd Sub'设置VBA编码保护Sub SetProtect()    Dim FileName As S

3、tring    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")    If FileName = CStr(False) Then       Exit Sub    Else       VBAPassword

4、 FileName, True    End IfEnd SubPrivate Function VBAPassword(FileName As String, Optional Protect As Boolean = False)      If Dir(FileName) = "" Then         Exit Function      Else

5、0;        FileCopy FileName, FileName & ".bak"      End If      Dim GetData As String * 5      Open FileName For Binary As #1      Dim CMGs As Long

6、0;     Dim DPBo As Long      For i = 1 To LOF(1)          Get #1, i, GetData          If GetData = "CMG=""" Then CMGs = i    

7、      If GetData = "Host" Then DPBo = i - 2: Exit For      Next           If CMGs = 0 Then         MsgBox "请先对VBA编码设置一个保护密码.", 32, "提示&

8、quot;         Exit Function      End If           If Protect = False Then         Dim St As String * 2       &

9、#160; Dim s20 As String * 1                 '取得一个0D0A十六进制字串         Get #1, CMGs - 2, St              '取得一个

10、20十六制字串         Get #1, DPBo + 16, s20              '替换加密部份机码         For i = CMGs To DPBo Step 2         

11、    Put #1, i, St         Next                 '加入不配对符号         If (DPBo - CMGs) Mod 2 <> 0 Then   &

12、#160;        Put #1, DPBo + 1, s20         End If         MsgBox "文件解密成功.", 32, "提示"      Else       

13、0; Dim MMs As String * 5         MMs = "DPB="""         Put #1, CMGs, MMs         MsgBox "对文件特殊加密成功.", 32, "提示"     

14、; End If      Close #1End FunctionExcel VBA密码破解工具（VBA实现）2007-10-13 08:00使用UltreEdit之类的十六进制编辑程序打开.XLS文件，在文本模式下查找“Host Extender Info”(也可只查Host)，切换到十六进制模式，将前面的“DBP"XXXXXXX.”的DBP关键字改成CBP，将“GC "XXXXXXX.”的GC关键字改成CC，使Excel不能识别此二项！存盘即可！ 用Excel打开此文件，忽略错误提示，进入VBA编辑器，嘿嘿，密码没有了

15、！做一次存盘操作即可修复错误提示。 Access的VBA工程密码采用无法破解！ 在很多地方我都说过，Excel VBA的工程密码是很脆弱的，其实吧里很早就有一篇这样的贴子，我也将其整理为加载宏不过还是有很多朋友在问：）。现将主程序的源代码也整理于此。如果不懂VBA的朋友，也可以去下载我整理的加载宏（点击下载，需要注册）。 '1>一段极好的VBA保护密码破解程序测试WIN98+OFFICE97破解率100% '2>用以下代码对VBA加密保护后用offkey 6.5-7.0及Advanced VBA pASSWORD Recovery专业版均无法破解出保护程式码的密码

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

17、; 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  

18、;   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

19、, 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  

20、60;     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

21、      '取得一个0D0A十六进制字串    Get #1, CMGs - 2, St    '取得一个20十六制字串    Get #1, DPBo + 16, s20    '替换加密部份机码    For i = CMGs To DPBo Step 2           Put #1, i, St    Next  

22、60;    '加入不配对符号    If (DPBo - CMGs) Mod 2 <> 0 Then       Put #1, DPBo + 1, s20    End If    MsgBox "文件解密成功.", 32, "提示" Else    Dim MMs As String * 5    MMs = "DPB=""" &#

23、160;  Put #1, CMGs, MMs    MsgBox "对文件特殊加密成功.", 32, "提示" End If Close #1 End FunctionOption Explicit'移除VBA?保?Sub MoveProtect() Dim FileName As String FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")

24、 If FileName = CStr(False) Then Exit Sub Else VBAPassword FileName, False End IfEnd 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 VBA

25、Password FileName, True End IfEnd SubPrivate Function VBAPassword(FileName As String, Optional Protect As Boolean = False) Dim i As Integer On Error Resume Next If Dir(FileName) = "" Then Exit Function Else FileCopy FileName, FileName & "_" & Format(Date, "YYYYMMDD&q

26、uot;) & Format(Time, "hhmmss") & ".bak" If Err.Number = "55" Then MsgBox "指定開。閉。" Exit Function End If 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 =

27、 "CMG=""" Then CMGs = i If GetData = "Host" Then DPBo = i - 2: Exit For Next If CMGs = 0 Then MsgBox "Excel、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

28、, 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 "VBA削除！.", 32, "提示" Else Dim MMs As String * 5 MMs = "DPB=""" Put

29、#1, CMGs, MMs MsgBox "VBA追加！.", 32, "提示" End If Close #1End FunctionExcel VBA工程密码破解程序 (绝对可以破解)2007-06-24 11:28新建一个Excel工作簿,Alt+F11 打开VBA编辑器,新建一个模块 ,复制以下代码,注意如提示变量未定义,则把Option Explicit行删除即可,经测试已经通过.'移除VBA编码保护Sub MoveProtect() Dim FileName As String FileName = Application.GetOp

30、enFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解") If FileName = CStr(False) Then Exit Sub Else VBAPassword FileName, False End IfEnd 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 IfEnd SubPrivate Function VBAPas