EXCEL工作表保护密码破解ZT

某领导

两天前在公司上班网上Q时，见到久违的工作一族的姑姑，她一份重要的工作报表密码遗失...于是我在网上找破解密码的软件，这破解的软件倒是很多，但都不适用，于是...继续搜索。想想念了三年的计算机，学到了什么...真是惭愧无言... 我的工作大部份也是做报表，是公司车辆的信息报表。重要的报表时常有密码保护，与报表密切联系的工作一族很需要知道这些知识，无疑这可以给我们的工作带来方便。 在网上找到了这份破解代码，成功破解了，但不能找到原表的密码，这是最遗憾的。还有破解的表的安全系数会低点。对工作报表一族超级无敌有用！！ 方法: 1\打开文件 " \! v" {" r: w8 d& \2\工具---宏----录制新宏---输入名字如:aa / m5 }. p1 K4 K5 \3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容复制吧) 4 }) p7 t4 [$ }# X& \6\关闭编辑窗口 5 i* R/ W/ v" Z5 G) A% F7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! 内容如下： 9 c7 }9 x- K8 {; ]( kPublic Sub AllInternalPasswords() * _ S. ^ g" F' 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 ' 4 m7 C I5 F! Q' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 8 `. O7 N2 t& I' Modified 2003-Apr-04 by JEM: All msgs to constants, and ' eliminate one Exit Sub (Version 1.1.1) " ^- e) v& L( S( y4 v' Reveals hashed passwords NOT original passwords Const DBLSPACE As String = vbNewLine & vbNewLine 9 x" M4 ?7 |' @* Z8 x6 u( pConst AUTHORS As String = DBLSPACE & vbNewLine & _ . h" {. W- }' n2 G K"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 & "lease report failure " & _ "to the microsoft.public.excel.programming newsgroup." # m* L2 O( k/ EConst ALLCLEAR As String = DBLSPACE & "The workbook should " & _ ' z b( }* W& o! y* q"now be free of all password protection, so make sure you:" & _ DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ : t. z$ S- F3 ^4 NDBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ DBLSPACE & "Also, remember that the password was " & _ + @: ~- j6 ?8 f"put there for a reason. Don't stuff up crucial formulas " & _ "or data." & DBLSPACE & "Access and use of some data " & _ . |" G( d/ I* x- l. q"may be an offense. If in doubt, don't." 5 ?$ l% `0 f5 jConst MSGNOPWORDS1 As String = "There were no passwords on " & _ 3 S' H7 E7 F/ K7 p' o"sheets, or workbook structure or windows." & AUTHORS & VERSION ( z& R) t8 d1 xConst MSGNOPWORDS2 As String = "There was no protection to " & _ ( S* S" j8 h; {; T"workbook structure or windows." & DBLSPACE & _ & m8 X/ u- E/ L: b' w"roceeding to unprotect sheets." & AUTHORS & VERSION Const MSGTAKETIME As String = "After pressing OK button this " & _ 9 D: d$ p& ^7 q+ i7 U4 I# N- M0 r! S"will take some time." & DBLSPACE & "Amount of time " & _ "depends on how many different passwords, the " & _ $ h- B& `9 M" @/ @! ^( v- M"passwords, and your computer's specification." & DBLSPACE & _ "Just be patient! Make me a coffee!" & AUTHORS & VERSION ' @& k4 Z' M& y# m1 O0 D3 JConst MSGPWORDFOUND1 As String = "You had a Worksheet " & _ $ X3 S. W6 f* \. e"Structure or Windows Password set." & DBLSPACE & _ / R$ y+ `7 O( k! M" B2 I3 j"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ 9 Z8 c, R) \' k% ~$ v: p8 I+ }+ l"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 " & _ ! m' ]( c& |* @) F; U0 M"password set." & DBLSPACE & "The password found was: " & _ $ P/ f; T. R- P5 ]! f! ~% a- }DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ * H0 T" w; N2 [1 Y/ L) `* Z9 S"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 1 C' k) z9 B4 v. I1 T( A8 aDim 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 , W" Z8 O* b4 \Dim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean + Z, V& w" g4 ~' l Application.ScreenUpdating = False ' U2 E& B# b8 n/ s( cWith ActiveWorkbook 7 _9 c3 |+ H& z9 y bWinTag = .ProtectStructure Or .ProtectWindows End With 0 h4 O" m+ |- I" XShTag = False . _; L7 t& O: G2 |/ e0 l8 rFor 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 7 m) w' q. D) |+ A1 j& WMsgBox MSGTAKETIME, vbInformation, HEADER ' c2 j& ?$ E0 ~& Z! H7 tIf Not WinTag Then 3 R" R1 G- ~( @' Z( nMsgBox MSGNOPWORDS2, vbInformation, HEADER * X) b3 _* |* |: i: wElse * J; G' T9 ~; b- N* L: oOn Error Resume Next Do 'dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 & G) g( H; y" F/ R6 G; S; UFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 1 B( H% r, Z: {4 B% DFor 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) & _ Z8 O) ]. j8 G' e5 XChr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ " }9 [6 ^- Z" UChr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ( _9 [2 I/ t7 XIf .ProtectStructure = False And _ & {4 y' v1 a6 q.ProtectWindows = False Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ / X6 Z* s2 U$ H, L4 @Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 2 k& @2 M& }0 c* P0 jMsgBox Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER 8 l- ]& b6 c; L4 |* xExit Do 'Bypass all for...nexts End If End With 4 y- N! A; T/ O5 @ WNext: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next 7 W8 z$ s8 i4 K) W+ h7 FLoop Until True On Error GoTo 0 * L$ j6 ~. q, ^1 B* VEnd If 2 \6 ]% g7 |6 YIf WinTag And Not ShTag Then " T/ g5 _/ ~& u5 p- w/ [* nMsgBox MSGONLYONE, vbInformation, HEADER ! [* V2 p$ C2 F! w- f. ~8 jExit Sub D7 L# b5 U2 R3 @1 C% P# X2 n& PEnd If , K* T7 g) m$ T; a- W8 gOn Error Resume Next , r1 q0 D' z; U9 l4 a0 h: pFor Each w1 In Worksheets 5 r6 u9 X/ s4 a; B'Attempt clearance with PWord1 1 _. Q. l! P. y. T, R: Iw1.Unprotect PWord1 ) a4 {9 [ g6 U% U8 w& r7 l% TNext w1 On Error GoTo 0 ShTag = False For Each w1 In Worksheets s* Q7 ^4 n) A" H'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContents Next w1 If ShTag Then ( {% Z% u5 e* Y, ]% m$ @For Each w1 In Worksheets 8 [9 j+ @- |5 G6 J0 T: BWith w1 If .ProtectContents Then On Error Resume Next 6 N4 k D, p1 ~! QDo 'Dummy do loop ! ^0 j U; q% Q1 x9 ~/ V5 F0 oFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 @( c4 j9 Y4 U8 Q; jFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 : t4 P: r! q* f5 t$ w: _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 % q# H; Z, b3 _.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 9 p" k) P# c8 Q/ u; N* FChr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ; i9 O7 n, D0 V9 B% `If Not .ProtectContents Then # }, u q: p7 R2 PPWord1 = 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, _ - ?: B' A4 i0 I) W L$ V"$$", PWord1), vbInformation, HEADER 'leverage finding Pword by trying on other sheets For Each w2 In Worksheets ) f9 u: I# p8 {0 Q8 Rw2.Unprotect PWord1 Next w2 Exit Do 'Bypass all for...nexts End If & J8 [, G! W- u( ^Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next ! ^8 [5 q" u5 J7 F v) E3 TLoop Until True 0 ]7 s8 e- l/ y3 ]9 W* C: GOn Error GoTo 0 6 {7 ]' e2 `! \9 s6 g# G" \9 EEnd If End With , s' W8 S$ C q) _ z# ^( xNext w1 ( d: z$ r- w- u% M8 W4 F" AEnd If " C2 U# E6 ^% IMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 8 C: b5 P% V/ ~! }8 @6 \! zEnd Sub j2 |# d2 I# \9 g3 V, D / {# }* N' ~2 O- f& c V) d今天解决的大问题！！