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

您所在的位置:网站首页 excel2022删除宏 破解Excel工作表保护,清除所有密码并获取密码

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

2024-07-10 04:01| 来源: 网络整理| 查看: 265

破解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文件

 点击启用内容

视图——宏——执行

 

 

 

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



【本文地址】


今日新闻


推荐新闻


CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3