• 破解Excel保护


    一、录制宏

    二、停止录制

    三、查看录制

    四、点击编辑进入VB编辑环境

    五、清空原有的内容,copy以下代码

    Public Sub 工作表保护密码破解()  
    Const DBLSPACE As String = vbNewLine & vbNewLine  
    Const AUTHORS As String = DBLSPACE & vbNewLine & _  
    "作者:McCormick   JE McGimpsey "  
    Const HEADER As String = "工作表保护密码破解"  
    Const VERSION As String = DBLSPACE & "版本 Version 1.1.1"  
    Const REPBACK As String = DBLSPACE & ""  
    Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _  
    & DBLSPACE & "注意:不要用在不当地方,要尊重他人的劳动成果!"  
    Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"  
    Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"  
    Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!"  
    Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _  
    "如果该文件工作表有不同密码,将搜索下一组密码并修改清除"  
    Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _  
    "如果该文件工作表有不同密码,将搜索下一组密码并解除"  
    Const MSGONLYONE As String = "确保为唯一的?"  
    Dim w1 As Worksheet, w2 As Worksheet  
    Dim i As Integer, j As Integer, k As Integer, l As Integer  
    Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer  
    Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer  
    Dim PWord1 As String  
    Dim ShTag As Boolean, WinTag As Boolean  
    Application.ScreenUpdating = False  
    With ActiveWorkbook  
    WinTag = .ProtectStructure Or .ProtectWindows  
    End With  
    ShTag = False  
    For Each w1 In Worksheets  
    ShTag = ShTag Or w1.ProtectContents  
    Next w1  
    If Not ShTag And Not WinTag Then  
    MsgBox MSGNOPWORDS1, vbInformation, HEADER  
    Exit Sub  
    End If  
    MsgBox MSGTAKETIME, vbInformation, HEADER  
    If Not WinTag Then  
    Else  
    On Error Resume Next  
    Do 'dummy do loop  
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66  
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66  
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66  
    For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126  
    With ActiveWorkbook  
    .Unprotect Chr(i) & Chr(j) & Chr(k) & _  
    Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _  
    Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)  
    If .ProtectStructure = False And _  
    .ProtectWindows = False Then  
    PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _  
    Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _  
    Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)  
    MsgBox Application.Substitute(MSGPWORDFOUND1, _  
    "$$", PWord1), vbInformation, HEADER  
    Exit Do 'Bypass all for...nexts  
    End If  
    End With  
    Next: Next: Next: Next: Next: Next  
    Next: Next: Next: Next: Next: Next  
    Loop Until True  
    On Error GoTo 0  
    End If  
      
    If WinTag And Not ShTag Then  
    MsgBox MSGONLYONE, vbInformation, HEADER  
    Exit Sub  
    End If  
    On Error Resume Next  
      
    For Each w1 In Worksheets  
    'Attempt clearance with PWord1  
    w1.Unprotect PWord1  
    Next w1  
    On Error GoTo 0  
    ShTag = False  
    For Each w1 In Worksheets  
    'Checks for all clear ShTag triggered to 1 if not.  
    ShTag = ShTag Or w1.ProtectContents  
    Next w1  
    If ShTag Then  
    For Each w1 In Worksheets  
    With w1  
    If .ProtectContents Then  
    On Error Resume Next  
    Do 'Dummy do loop  
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66  
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66  
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66  
    For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126  
    .Unprotect Chr(i) & Chr(j) & Chr(k) & _  
    Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _  
    Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)  
    If Not .ProtectContents Then  
    PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _  
    Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _  
    Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)  
    MsgBox Application.Substitute(MSGPWORDFOUND2, _  
    "$$", PWord1), vbInformation, HEADER  
    'leverage finding Pword by trying on other sheets  
    For Each w2 In Worksheets  
    w2.Unprotect PWord1  
    Next w2  
    Exit Do 'Bypass all for...nexts  
    End If  
    Next: Next: Next: Next: Next: Next  
    Next: Next: Next: Next: Next: Next  
    Loop Until True  
    On Error GoTo 0  
    End If  
    End With  
    Next w1  
    End If  
    MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK , vbInformation, HEADER  
    End Sub  

    六、保存后执行程序,即可破解成功

  • 相关阅读:
    [20220314]利用vim下使用gdb进行各种进制转换插件.txt
    [20220228]enq TX allocate ITL entry的测试3.txt
    php输出json时,如何将空数组转为空对象
    C# String 前面不足位数补零的方法
    Gitlab权限管理
    Sql Server 存储乱码,出现问号?显示
    【填坑】处理:java: 错误: 不支持发行版本 5
    运行从sapui5官网下载代码的方法
    通过Fiori app的名字,找到sewg里的project
    SAPUI5 Fiori课程计划
  • 原文地址:https://www.cnblogs.com/newcaoguo/p/6113212.html
Copyright © 2020-2023  润新知