电脑技术 订阅所有【电脑技术】的日志
2010-08
31

excel工作表保护密码破解(可行有效) 的方法

作者:桑三 日期:2010-08-31

字体大小: 小 中 大

        一个excel文档要修改其中的内容，可是被保护了，怎么也修改不了。找了一堆破解软件，要么需要购买，要么是破解打开密码的，非保护密码。好不容易找到解决方案！现在给大家分享下。

       excel工作表保护密码破解(可行有效) 的方法：

1、打开被保护的excel工作表；

2、工具---宏----录制新宏---输入一个宏名，如宏名为sangsan；

3、确定后出来一个可以点停止的东西，点停止录制（这样得到一个空宏）；

4、工具---宏----宏，选刚才录制的宏，如宏名为sangsan的，再点编辑按钮；

5、删除代码框中的所有文字，用下面的代码复制粘贴进去，然后关闭（会自动保存的）；

6、回到工作表，点工具-宏选AllInternalPasswords，再点右边的执行；

7、出来两次点确定，然后就开始破解密码了，等几分钟（密码复杂可能更久）有就会提示你密码，同时保护excel工作表保护密码也去掉了，可以正常修改录入数据了。至此破解成功。

excel工作表保护密码破解宏代码：

宏代码
  1. Public Sub AllInternalPasswords()   
  2. ' Breaks worksheet and workbook structure passwords. Bob McCormick  
  3. ' probably originator of base code algorithm modified for coverage   
  4. ' of workbook structure / windows passwords and for multiple passwords  
  5. '  
  6. ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)  
  7. ' Modified 2003-Apr-04 by JEM: All msgs to constants, and   
  8. ' eliminate one Exit Sub (Version 1.1.1)  
  9. ' Reveals hashed passwords NOT original passwords   
  10. Const DBLSPACE As String = vbNewLine & vbNewLine   
  11. Const AUTHORS As String = DBLSPACE & vbNewLine & _   
  12. "Adapted from Bob McCormick base code by" & _   
  13. "Norman Harker and JE McGimpsey"  
  14. Const HEADER As String = "AllInternalPasswords User Message"  
  15. Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"  
  16. Const REPBACK As String = DBLSPACE & "Please report failure " & _   
  17. "to the microsoft.public.excel.programming newsgroup."  
  18. Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _   
  19. "now be free of all password protection, so make sure you:" & _   
  20. DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _   
  21. DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _   
  22. DBLSPACE & "Also, remember that the password was " & _   
  23. "put there for a reason. Don't stuff up crucial formulas " & _   
  24. "or data." & DBLSPACE & "Access and use of some data " & _   
  25. "may be an offense. If in doubt, don't."  
  26. Const MSGNOPWORDS1 As String = "There were no passwords on " & _   
  27. "sheets, or workbook structure or windows." & AUTHORS & VERSION   
  28. Const MSGNOPWORDS2 As String = "There was no protection to " & _   
  29. "workbook structure or windows." & DBLSPACE & _   
  30. "Proceeding to unprotect sheets." & AUTHORS & VERSION   
  31. Const MSGTAKETIME As String = "After pressing OK button this " & _   
  32. "will take some time." & DBLSPACE & "Amount of time " & _   
  33. "depends on how many different passwords, the " & _   
  34. "passwords, and your computer's specification." & DBLSPACE & _   
  35. "Just be patient! Make me a coffee!" & AUTHORS & VERSION   
  36. Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _   
  37. "Structure or Windows Password set." & DBLSPACE & _   
  38. "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _   
  39. "Note it down for potential future use in other workbooks by " & _   
  40. "the same person who set this password." & DBLSPACE & _   
  41. "Now to check and clear other passwords." & AUTHORS & VERSION   
  42. Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _   
  43. "password set." & DBLSPACE & "The password found was: " & _   
  44. DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _   
  45. "future use in other workbooks by same person who " & _   
  46. "set this password." & DBLSPACE & "Now to check and clear " & _   
  47. "other passwords." & AUTHORS & VERSION   
  48. Const MSGONLYONE As String = "Only structure / windows " & _   
  49. "protected with the password that was just found." & _   
  50. ALLCLEAR & AUTHORS & VERSION & REPBACK   
  51. Dim w1 As Worksheet, w2 As Worksheet   
  52. Dim i As Integer, j As Integer, k As Integer, l As Integer   
  53. Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer   
  54. Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer   
  55. Dim PWord1 As String   
  56. Dim ShTag As Boolean, WinTag As Boolean   
  57. Application.ScreenUpdating = False   
  58. With ActiveWorkbook   
  59. WinTag = .ProtectStructure Or .ProtectWindows   
  60. End With   
  61. ShTag = False   
  62. For Each w1 In Worksheets   
  63. ShTag = ShTag Or w1.ProtectContents   
  64. Next w1   
  65. If Not ShTag And Not WinTag Then   
  66. MsgBox MSGNOPWORDS1, vbInformation, HEADER   
  67. Exit Sub   
  68. End If   
  69. MsgBox MSGTAKETIME, vbInformation, HEADER   
  70. If Not WinTag Then   
  71. MsgBox MSGNOPWORDS2, vbInformation, HEADER   
  72. Else   
  73. On Error Resume Next   
  74. Do 'dummy do loop   
  75. For i = 65 To 66: For j = 65 To 66: For k = 65 To 66   
  76. For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66   
  77. For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66   
  78. For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126   
  79. With ActiveWorkbook   
  80. .Unprotect Chr(i) & Chr(j) & Chr(k) & _   
  81. Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _   
  82. Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
  83. If .ProtectStructure = False And _   
  84. .ProtectWindows = False Then   
  85. PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _   
  86. Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _   
  87. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
  88. MsgBox Application.Substitute(MSGPWORDFOUND1, _   
  89. "$$", PWord1), vbInformation, HEADER   
  90. Exit Do 'Bypass all for...nexts  
  91. End If  
  92. End With  
  93. Next: Next: Next: Next: Next: Next  
  94. Next: Next: Next: Next: Next: Next  
  95. Loop Until True  
  96. On Error GoTo 0  
  97. End If  
  98. If WinTag And Not ShTag Then  
  99. MsgBox MSGONLYONE, vbInformation, HEADER  
  100. Exit Sub  
  101. End If  
  102. On Error Resume Next  
  103. For Each w1 In Worksheets  
  104. 'Attempt clearance with PWord1   
  105. w1.Unprotect PWord1   
  106. Next w1   
  107. On Error GoTo 0   
  108. ShTag = False   
  109. For Each w1 In Worksheets   
  110. 'Checks for all clear ShTag triggered to 1 if not.  
  111. ShTag = ShTag Or w1.ProtectContents  
  112. Next w1  
  113. If ShTag Then  
  114. For Each w1 In Worksheets  
  115. With w1  
  116. If .ProtectContents Then  
  117. On Error Resume Next  
  118. Do 'Dummy do loop   
  119. For i = 65 To 66: For j = 65 To 66: For k = 65 To 66   
  120. For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66   
  121. For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66   
  122. For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126   
  123. .Unprotect Chr(i) & Chr(j) & Chr(k) & _   
  124. Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _   
  125. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
  126. If Not .ProtectContents Then   
  127. PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _   
  128. Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _   
  129. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
  130. MsgBox Application.Substitute(MSGPWORDFOUND2, _   
  131. "$$", PWord1), vbInformation, HEADER   
  132. 'leverage finding Pword by trying on other sheets  
  133. For Each w2 In Worksheets  
  134. w2.Unprotect PWord1  
  135. Next w2  
  136. Exit Do 'Bypass all for...nexts   
  137. End If   
  138. Next: Next: Next: Next: Next: Next   
  139. Next: Next: Next: Next: Next: Next   
  140. Loop Until True   
  141. On Error GoTo 0   
  142. End If   
  143. End With   
  144. Next w1   
  145. End If   
  146. MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER   
  147. End Sub  

 





上一篇: 线人[DVD国语中字]高清在线观看提供下载
下一篇: 《植物大战僵尸年度版》简体中文版下载
文章来自: 源于网络
引用通告: 查看所有引用 | 我要引用此文章
Tags: 技术 电脑 操作系统 资源共享
相关日志:
评论: 0 | 引用: 0 | 查看次数: -
发表评论
昵　称:
密　码: 游客发言不需要密码.
邮　箱: 邮件地址支持Gravatar头像,邮箱地址不会公开.
网　址: 输入网址便于回访.
内　容:
验证码:
选　项:
虽然发表评论不用注册，但是为了保护您的发言权，建议您注册帐号.
 字数限制 1000 字 | UBB代码 开启 | [img]标签 关闭