破解Excel工作表保护,清除所有密码并获取密码

破解Excel工作表保护,清除所有密码并获取密码

破解Excel工作表保护

试图修改警告

破解原理

Excel中内置了Visual Basic,通过宏实现破解密码

破解步骤

1、打开准备破解的Excel,视图——宏——录制宏

2、宏名随意填写,保存在当前工作簿

3、查看宏——选择我们新建的宏——编辑

4、将下面的代码替换掉原有函数,关掉Visual Basic即可

Public Sub Password_cracking()

Const DBLSPACE As String = vbNewLine & vbNewLine

Const AUTHORS As String = DBLSPACE & vbNewLine & _

" Author - jnxxhzz "

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

5、回到工作簿Ctrl+S 保存会弹出如下窗口

这里点击否 保存文件类型为启用宏的工作簿 .xlsm

单击确定即可

实现结果

打开保存的xlsm文件

点击启用内容

视图——宏——执行

这里已经清除所有密码,再打开的时候就可以修改了

相关推荐

一般家庭买700还是800微波炉?微波炉瓦数怎么选择?
柚子双开助手手机版下载

柚子双开助手手机版下载

📅 06-29 👁️ 9556
赛尔号神秘的泰坦源脉怎么打 泰坦材料怎么获得