zoukankan      html  css  js  c++  java
  • Excel工作表保护的密码破解与清除...假装自己破解密码系列?

    有一次我女朋友让我帮忙解一个excel表格的保护密码,然后~用了宏

    网上下载来的Excel经常会有工作表保护,也就是无法修改,妄图做任何修改的时候你就会看见这句话:

    您试图更改的单元格或图表位于受保护的工作表中。若要进行更改,请取消工作表保护。您可能需要输入密码。

    那么这篇文章可以简单的帮你解决这个问题...因为Excel中内置了Visual Basic,所以我们写个宏暴力破解密码就可以了。。。

    1. 当然是先打开有保护密码的Excel文件

    2. 新建一个宏(不同版本的office宏所在的位置不一样,一般都在"菜单—视图" 中)

    然后我们点击"录制宏",名字随便写,然后再次点击,会发现录制宏的位置已经变成了“停止录制”,点击“停止录制”

    3.在停止录制后我们点击“查看宏”,找到我们刚才新建的宏,比如我新建的名为“asd”,选中后点击"编辑"

    4. 然后在弹出的框中我们可以看到我们新建的空宏"asd"

    5. 把这个框内的所有内容全部删除,将下面的所有代码复制进去

    6. 关闭Visual Basic,回到我们的Excel,当然这里不需要保存,直接右上角叉掉即可

    7. 然后我们回到最初的位置,点击“查看宏”,就会发现刚才我们新建的空宏已经不见了,取而代之的是一个名为"Password_cracking"的宏

    8. 选中这个宏,点击执行,就可以破解当前这份Excel中的工作保护密码了

    当然在执行完这个宏之后,当前打开的Excel中的密码已经被清除,你可以选择直接保存这份Excel,这样的话你的Excel就不再有密码了,也可以选择记下破解出来的密码,然后关闭这个Excel重新打开一次,输入密码解除保护

    Public Sub Password_cracking()
    Const DBLSPACE As String = vbNewLine & vbNewLine
    Const AUTHORS As String = DBLSPACE & vbNewLine & _
    "                      Author - GhostCN_Z "
    Const HEADER As String = "Password_cracking"
    Const VERSION As String = DBLSPACE & "                      Version 1.0"
    Const REPBACK As String = DBLSPACE & ""
    Const ZHENGLI As String = DBLSPACE & ""
    Const ALLCLEAR As String = DBLSPACE & "All password is clear" & DBLSPACE & "Please remember to save" 
    Const MSGNOPWORDS1 As String = "No password!"
    Const MSGNOPWORDS2 As String = "No password!"
    Const MSGTAKETIME As String = "This will take some time , please wait for a while" & DBLSPACE & "Press next to start"
    Const MSGPWORDFOUND1 As String = "Password is : " & DBLSPACE & "$$" & DBLSPACE & _
    "If the file worksheet has a different password, it will search for the next set of passwords and release"
    Const MSGPWORDFOUND2 As String = "Password is : " & DBLSPACE & "$$" & DBLSPACE & _
    "If the file worksheet has a different password, it will search for the next set of passwords and release"
    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 & ZHENGLI, vbInformation, HEADER
    End Sub
  • 相关阅读:
    Mysql-存储过程-批量增加数据
    VIM
    查看Chrome浏览器同步数据状态工具
    Tomcat运行配置
    mysql的engine不同,导致事物回滚失败的问题
    git在MAC,Linux的terminator(命令行)下自动显示当前分支
    SED单行脚本快速参考(Unix 流编辑器)
    awk中使用shell的环境变量
    Grep Sed Awk
    shred_linux_unix
  • 原文地址:https://www.cnblogs.com/1oo88/p/10652866.html
Copyright © 2011-2022 走看看