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