EXCEL工作表保护密码破解ZT

某领导

两天前在公司上班网上Q时，见到久违的工作一族的姑姑，她一份重要的工作报表密码遗失...于是我在网上找破解密码的软件，这破解的软件倒是很多，但都不适用，于是...继续搜索。想想念了三年的计算机，学到了什么...真是惭愧无言... 我的工作大部份也是做报表，是公司车辆的信息报表。重要的报表时常有密码保护，与报表密切联系的工作一族很需要知道这些知识，无疑这可以给我们的工作带来方便。 在网上找到了这份破解代码，成功破解了，但不能找到原表的密码，这是最遗憾的。还有破解的表的安全系数会低点。对工作报表一族超级无敌有用！！ 方法: ' T% U5 B9 `+ S1\打开文件 0 s$ E" w; s: S+ ^7 i/ U t& l2\工具---宏----录制新宏---输入名字如:aa , l1 s4 d7 V( A! z7 F3\停止录制(这样得到一个空宏) 6 h4 \, k! q+ M9 Q5 X" H4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容复制吧) & G8 J" y2 m; E6\关闭编辑窗口 7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! 内容如下： 1 ~2 T) X" F: U9 s' w/ ePublic Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords. Bob McCormick ' probably originator of base code algorithm modified for coverage 4 q: E4 y! B& c# E+ t- S, x' 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 3 m# t) n: b9 q6 B c n% f& k' eliminate one Exit Sub (Version 1.1.1) ! |- q3 j7 O) Q' Reveals hashed passwords NOT original passwords Const DBLSPACE As String = vbNewLine & vbNewLine ) d) m* m* ?: _- ~* ^+ t6 E( }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" " A" a: q/ A( s. rConst VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" + u( M( ^3 M1 ^0 v4 |, iConst REPBACK As String = DBLSPACE & "lease report failure " & _ $ N& W0 {( g9 a* w# M) X2 h4 z( a"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:" & _ " l8 b9 x! r4 X. f3 A( t; @/ }5 ]% vDBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ $ j: X+ M8 K: J8 A( n! R8 _/ sDBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ DBLSPACE & "Also, remember that the password was " & _ "put there for a reason. Don't stuff up crucial formulas " & _ . Q3 t. t9 _0 u( v# F+ |/ z"or data." & DBLSPACE & "Access and use of some data " & _ 7 o9 A: j# N, U6 G( c"may be an offense. If in doubt, don't." Const MSGNOPWORDS1 As String = "There were no passwords on " & _ 3 Q7 L2 Q+ T" \" u I |"sheets, or workbook structure or windows." & AUTHORS & VERSION 4 s# \. B8 D' A5 l% ?: A- ZConst MSGNOPWORDS2 As String = "There was no protection to " & _ ) |: ]: c5 Y' U' D- I7 H ]"workbook structure or windows." & DBLSPACE & _ 7 n' h/ j& I0 H+ A" j! v"roceeding to unprotect sheets." & AUTHORS & VERSION 5 B" P! [! M' j; b# mConst MSGTAKETIME As String = "After pressing OK button this " & _ : X: g b* j' ?$ U, A- e"will take some time." & DBLSPACE & "Amount of time " & _ "depends on how many different passwords, the " & _ $ ~3 ]+ r# K7 S. b"passwords, and your computer's specification." & DBLSPACE & _ + n% o% ?/ ^% S% f! E5 L# W"Just be patient! Make me a coffee!" & AUTHORS & VERSION / p* O9 c1 m/ L; y, A5 bConst MSGPWORDFOUND1 As String = "You had a Worksheet " & _ "Structure or Windows Password set." & DBLSPACE & _ 0 y$ p; Z- @" v"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ "Note it down for potential future use in other workbooks by " & _ / ~# y. V+ T" b: a0 B( T8 c% L3 _1 C"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: " & _ U! J: ]. d {* l4 ]: DDBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ 4 D$ k( m Y- H R( b" ^"future use in other workbooks by same person who " & _ "set this password." & DBLSPACE & "Now to check and clear " & _ % ]7 h: @. _, {* i; i5 V"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 & n2 ^9 M4 r3 z, Z. S: L5 }5 DDim i As Integer, j As Integer, k As Integer, l As Integer - u1 C3 d/ k* r5 P6 FDim m As Integer, n As Integer, i1 As Integer, i2 As Integer 4 J u) Q; v1 V3 F$ n! }" O& m; oDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer " w5 U0 a8 U: O* G2 N9 ^Dim PWord1 As String ) w+ m- V( U0 ^3 a: R2 IDim ShTag As Boolean, WinTag As Boolean ( y( A4 B$ B4 t5 D Application.ScreenUpdating = False With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows ' H; ?, U8 p, I% NEnd With ShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag And Not WinTag Then 7 G- A M4 b! zMsgBox MSGNOPWORDS1, vbInformation, HEADER 8 r) E: Z# p6 a- _8 ~Exit Sub End If MsgBox MSGTAKETIME, vbInformation, HEADER If Not WinTag Then ' }% \, u! T: G9 F0 _MsgBox MSGNOPWORDS2, vbInformation, HEADER ! v( W9 O7 p `/ sElse On Error Resume Next 8 x1 r% r$ o# t9 ^) b3 q7 r6 C2 RDo 'dummy do loop . A) U& Z! y& [6 T# F) f4 J+ PFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 . l. x! b- N3 V! {: tFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 1 m% R3 o8 e3 I$ yFor 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) 7 _$ e3 ^1 u1 X0 @: fIf .ProtectStructure = False And _ .ProtectWindows = False Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ + |% m/ L3 C( }2 c; l: iChr(i4) & Chr(i5) & Chr(i6) & Chr(n) ! Z3 w$ I i( AMsgBox Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER Exit Do 'Bypass all for...nexts End If 7 n( L' k: j4 F ~. F% ZEnd With . i) u5 G8 _- E7 O0 C8 c$ N* hNext: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True ' R% }8 z, h- q8 }, U6 R6 DOn Error GoTo 0 End If & I, A. G4 ]- A+ y+ R( `5 nIf WinTag And Not ShTag Then ( ?$ e c/ U( D7 g% [, V2 TMsgBox MSGONLYONE, vbInformation, HEADER 3 U/ C6 Q u# i8 x: g2 J8 u4 t. `( [Exit Sub ! I; {4 \4 H. r; d8 xEnd If \( t, U# E5 kOn Error Resume Next For Each w1 In Worksheets / a; n# G3 O! ~'Attempt clearance with PWord1 w1.Unprotect PWord1 Next w1 On Error GoTo 0 ' [; q2 E; [" H8 m% hShTag = False For Each w1 In Worksheets ' T: ]3 r3 G2 ^4 _7 r) {! U( k'Checks for all clear ShTag triggered to 1 if not. 0 U2 j2 \1 l" ]0 U& r8 n' mShTag = ShTag Or w1.ProtectContents Next w1 If ShTag Then . h: z: a' ^' s: N0 o% y8 NFor Each w1 In Worksheets * s1 l4 ~! u1 K* QWith w1 / r1 r; X% Z t, b% r. ^) IIf .ProtectContents Then On Error Resume Next Do 'Dummy do loop ' E5 p( L4 j( b& W* l2 G, NFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 : M. G1 ] f; I/ S) t- G1 P. SFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 $ ?; Y8 X `* S6 UFor 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 . a( I P; g+ S$ X) T. i: q.Unprotect Chr(i) & Chr(j) & Chr(k) & _ , M2 {( u( u+ A' A; T/ _1 @, @Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 0 o) g, i, y6 j0 p0 U" xChr(i4) & Chr(i5) & Chr(i6) & Chr(n) % V2 k- p9 c# `0 W9 W) `If Not .ProtectContents Then & u' a L6 ?% ] K2 sPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ ' f( ?9 U# B4 _. t; tChr(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 2 p0 O* _% A* X& J6 \6 N) b2 {w2.Unprotect PWord1 6 \: k; r, o5 p5 C+ dNext w2 Exit Do 'Bypass all for...nexts End If / ^- B% x" y/ b- ?6 d$ aNext: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next ( a# K/ F- n% ?/ @) @Loop Until True On Error GoTo 0 9 q7 p `! `( V- O EEnd If * k6 { L/ D% v& c4 x' C3 IEnd With ' p; \5 p4 ?; |! M( N0 q0 q& ~& a; ]Next w1 End If ; J- U: z. J' [/ B& e' jMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER ! \. j6 B9 {, \. KEnd Sub 4 S' v7 @! z: n 今天解决的大问题！！