当前位置:
  1. 首页 »
  2. 笔记 »
  3. 正文

VBA代码破解excel密码保护,支持2003,2007

零分 2,447

Excel密码保护之后只能只读,不能进行修改操作,想要修改就需要对excel进行破解,当然,是在不知道密码的情况下!

这是一个经过密码保护的excel表格,现在开始破解工作!

1、打开密码保护的excel文件–工具–录制新宏–输入名字如:xp  –点击停止录制!

2、工具–宏–宏,选xp,点编辑按钮

3、删除窗口的代码,替换VBA破解代码:

VBA代码:

ublic Sub AllInternalPasswords()    
' Breaks worksheet and workbook structure passwords. Bob McCormick    
' probably originator of base code algorithm modified for coverage    
' of workbook structure / windows passwords and for multiple passwords    
'    
' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)    
' Modified 2003-Apr-04 by JEM: All msgs to constants, and    
' eliminate one Exit Sub (Version 1.1.1)    
' Reveals hashed passwords NOT original passwords    
Const DBLSPACE As String = vbNewLine & vbNewLine    
Const AUTHORS As String = DBLSPACE & vbNewLine & _    
"Adapted from Bob McCormick base code by" & _    
"Norman Harker and JE McGimpsey"    
Const HEADER As String = "AllInternalPasswords User Message"    
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"    
Const REPBACK As String = DBLSPACE & "Please report failure " & _    
"to the microsoft.public.excel.programming newsgroup."    
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _    
"now be free of all password protection, so make sure you:" & _    
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _    
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _    
DBLSPACE & "Also, remember that the password was " & _    
"put there for a reason. Don't stuff up crucial formulas " & _    
"or data." & DBLSPACE & "Access and use of some data " & _    
"may be an offense. If in doubt, don't."    
Const MSGNOPWORDS1 As String = "There were no passwords on " & _    
"sheets, or workbook structure or windows." & AUTHORS & VERSION    
Const MSGNOPWORDS2 As String = "There was no protection to " & _    
"workbook structure or windows." & DBLSPACE & _    
"Proceeding to unprotect sheets." & AUTHORS & VERSION    
Const MSGTAKETIME As String = "After pressing OK button this " & _    
"will take some time." & DBLSPACE & "Amount of time " & _    
"depends on how many different passwords, the " & _    
"passwords, and your computer's specification." & DBLSPACE & _    
"Just be patient! Make me a coffee!" & AUTHORS & VERSION    
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _    
"Structure or Windows Password set." & DBLSPACE & _    
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _    
"Note it down for potential future use in other workbooks by " & _    
"the same person who set this password." & DBLSPACE & _    
"Now to check and clear other passwords." & AUTHORS & VERSION    
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _    
"password set." & DBLSPACE & "The password found was: " & _    
DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _    
"future use in other workbooks by same person who " & _    
"set this password." & DBLSPACE & "Now to check and clear " & _    
"other passwords." & AUTHORS & VERSION    
Const MSGONLYONE As String = "Only structure / windows " & _    
"protected with the password that was just found." & _    
ALLCLEAR & AUTHORS & VERSION & REPBACK    
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    
MsgBox MSGNOPWORDS2, vbInformation, HEADER    
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  

4、关闭编辑窗口–工具—宏—宏,选AllInternalPasswords,执行,弹出的所有窗口都点击确定,直到不再弹出,破解完成!

PS:如果excel表格内容比较多的话,可能会出现无反应的情况,等待一会就可以了!破解之后记得保存!

网站设置开灯(亮模式/白天)和关灯(暗模式/黑夜)效果

在很早之前,这个效果叫做开灯/关灯,现在叫做白天/黑夜,曾经有那么一段时间没有看到过这种效果,现在又很多网站/APP都喜欢这种切换白天/黑夜模式。 实现效果:设置2套或者多套色调模板,和之前的那种换皮肤大差不差。所以博客新主题也设置了这么一个效果,样式布局基本没怎么改变,后台设置页升级了一下,很多东西都不再“写死”,可以自由设置! 白天模式效果: 黑夜模式效果: 感觉黑夜的色调比较好看。 总体涉及到的原理: 1、设计2套或者多套CSS样式,可以在body里添加一个class,后面保留class/ID样式名称不变,在不同的样式里给设计一个区域,通过body里的class名调用不同的样式CSS。
笔记 2,182

记一次网页源码顶部空白行的问题处理

正常来说,网页源码顶部如非UFT-8 bom编码的问题,基本不会影响网站的正常运行,但如php生成xml的话,就会出现问题。 因更换了主题(新主题暂时未上线,只是测试),发现xml无法正常显示,查看源码,顶部多出了一行空白行,本地运行正常。 查找原因,基本每个PHP问题都排查了,未发现任何问题,将主题上传到另外一个网站运行,发现正常。基本可以排除是主题的原因,剩下的可能是插件的问题。 查看了插件的源码,发现真的是插件的问题,PHP插件文件底部多出了几行,删除多出的行,重新运行,空白行不见了! 记录下,防止下次又因同样的原因而花时间去排查!
笔记 2,315

wordpress禁用REST API导致古腾堡编辑器发布文章出错问题

wordpress禁用REST API,在function.php中加入以下代码: add_filter("json_enabled", "__return_false"); add_filter("json_jsonp_enabled", "__return_false"); add_filter("rest_enabled", "__return_false"); add_filter("rest_jsonp_enabled", "__return_false"); remove_action("init", "rest_api_init"); remove_action("rest_ap
笔记 1,168

wordpress 后台主题设置选项按钮(button、input submit)点击屏蔽提交事件禁止刷新

wordpress 后台主题设置选项按钮(button、input submit)点击屏蔽提交事件禁止刷新 如果在设计主题或者插件后台设置选项时,wordpress后台的按钮(button、input submit)默认是提交操作,如只是响应JS事件,需要屏蔽提交,防止页面刷新。e.preventDefault(); 完整示例: $("button.copy").on("click",function(e){ e.preventDefault(); JS操作 });
笔记 1,051

pr2020(Adobe Premiere Pro 2020),运行时提示不支持的视频驱动

首先说下,PR2020是大神的破解版,运行的时候有登录账号,点击了试用(记得以前登录不需要点试用)不知道是否能正常持续试用。 电脑系统是windows 11,之前是Windows10,想提样下Windows11 就升级到了Windows11,因为可能是因为笔记本不支持TMP2.0,用了绕过的方法安装了Windows11,所以需要重新安装PR 在运行PR的时候,提示不支持的视频驱动,通过驱动总裁也无法解决,之前就一直不理会使用。 在官网上看到,支持Game Ready 驱动程序。 NVIDIA 已停止发布适用于旧版 GPU(9 系列及更低版本)的 Studio 驱动程序。但是,最新的 Game
笔记 1,877