EXCEL工作表保护密码破解ZT

某领导

两天前在公司上班网上Q时，见到久违的工作一族的姑姑，她一份重要的工作报表密码遗失...于是我在网上找破解密码的软件，这破解的软件倒是很多，但都不适用，于是...继续搜索。想想念了三年的计算机，学到了什么...真是惭愧无言... 我的工作大部份也是做报表，是公司车辆的信息报表。重要的报表时常有密码保护，与报表密切联系的工作一族很需要知道这些知识，无疑这可以给我们的工作带来方便。 在网上找到了这份破解代码，成功破解了，但不能找到原表的密码，这是最遗憾的。还有破解的表的安全系数会低点。对工作报表一族超级无敌有用！！ 方法: 4 M, k1 j: E$ ]: d1 C2 u+ @2 ]1\打开文件 2\工具---宏----录制新宏---输入名字如:aa 3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 - |6 P& D- d2 _5 T8 c5\删除窗口中的所有字符(只有几个),替换为下面的内容复制吧) & I0 M3 y4 ]* t6\关闭编辑窗口 " x" \6 x( C, n7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! 内容如下： Public 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 / g0 ^9 l" _+ s' }8 d, L& Y- c! H& J' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ) @) |6 g3 c( m7 Z; E! \8 F& S& q" o' Modified 2003-Apr-04 by JEM: All msgs to constants, and ' eliminate one Exit Sub (Version 1.1.1) ) W m) i) Y8 m$ ]" G' Reveals hashed passwords NOT original passwords Const DBLSPACE As String = vbNewLine & vbNewLine : O7 J/ |2 \, ] S+ EConst AUTHORS As String = DBLSPACE & vbNewLine & _ + E$ c& ]+ o7 ^& M( R" v- T, j"Adapted from Bob McCormick base code by" & _ ' k8 v& G& C0 b4 Z: K" \; M"Norman Harker and JE McGimpsey" Const HEADER As String = "AllInternalPasswords User Message" Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" 1 d' s: ^* g7 q. W) lConst REPBACK As String = DBLSPACE & "lease report failure " & _ ; D+ ]" j3 h: h+ z, q"to the microsoft.public.excel.programming newsgroup." % ^7 w( K; f' R0 [Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _ . K0 G1 A$ B+ L! g m- c/ `"now be free of all password protection, so make sure you:" & _ DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 2 i' v- J4 x# iDBLSPACE & "Also, remember that the password was " & _ 0 z9 {. l, s, z"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." ! R! K; ?: n2 L% Y* m7 kConst MSGNOPWORDS1 As String = "There were no passwords on " & _ 1 p5 i3 _0 X8 F& ?"sheets, or workbook structure or windows." & AUTHORS & VERSION Const MSGNOPWORDS2 As String = "There was no protection to " & _ $ B5 o8 [8 G# J7 o"workbook structure or windows." & DBLSPACE & _ 9 E3 F; y: Z3 t"roceeding to unprotect sheets." & AUTHORS & VERSION ; v4 p. b4 _# SConst MSGTAKETIME As String = "After pressing OK button this " & _ / n/ Y) _3 K: H"will take some time." & DBLSPACE & "Amount of time " & _ + E; ^: H3 L( e2 v7 {"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 & _ 2 W9 V& j% |! {5 a+ ]- `"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 " & _ 1 s) p1 I. o0 T1 P. Q( G8 V"future use in other workbooks by same person who " & _ 3 {9 V: s, u" Z"set this password." & DBLSPACE & "Now to check and clear " & _ 2 [' n' j! ~% t"other passwords." & AUTHORS & VERSION Const MSGONLYONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ ( y; ]/ `4 A% L5 k2 j# _1 \ALLCLEAR & AUTHORS & VERSION & REPBACK Dim w1 As Worksheet, w2 As Worksheet Dim i As Integer, j As Integer, k As Integer, l As Integer 6 d4 `7 ?) L# x! c) Y% h& }1 HDim 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 - Q+ Q% y6 u! I: [/ }: c( f, O" mDim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean 6 W! o I3 P, g4 h0 s Application.ScreenUpdating = False With ActiveWorkbook : A: T8 ^( b; t5 `8 F2 @1 s! m AWinTag = .ProtectStructure Or .ProtectWindows ; ?. N r! @$ f: @End With ! c( A: e& N& {- y4 CShTag = False 2 z" T% G# N1 g( o( Z4 O% [( i0 FFor Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 8 J. u2 D2 V. _$ YIf Not ShTag And Not WinTag Then MsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub End If MsgBox MSGTAKETIME, vbInformation, HEADER ! k* ]; Z: z, zIf Not WinTag Then MsgBox MSGNOPWORDS2, vbInformation, HEADER Else 8 f" m5 }$ w) L' g6 K: YOn Error Resume Next Do 'dummy do loop # t- G1 ~# U) G4 yFor 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 ' s. W( L! r& u! C' \% N. L0 }For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 0 |; B0 V. ~- D4 b+ U( M0 E2 mFor i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 Y$ A* p0 @! l' pWith ActiveWorkbook .Unprotect Chr(i) & Chr(j) & Chr(k) & _ 4 i2 Y, U2 U) \& |7 XChr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 9 E* ]/ `- Q0 DIf .ProtectStructure = False And _ , I" B) X0 M! @8 M: h( O9 |.ProtectWindows = False Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ ) E6 z; b: ~" NChr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND1, _ 2 W& N% @/ ? s p4 H6 |"$$", PWord1), vbInformation, HEADER 6 e' u2 M q5 W( k8 ZExit Do 'Bypass all for...nexts 4 _, J1 N& w( u$ @: S" A) ?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 . y+ t- y5 ?* ?If WinTag And Not ShTag Then 6 F' a# A8 {. j4 T5 [1 \+ L, jMsgBox MSGONLYONE, vbInformation, HEADER Exit Sub ; W/ p& P8 F8 c& xEnd If On Error Resume Next For Each w1 In Worksheets 3 V1 n# d8 |; b% P9 M/ r'Attempt clearance with PWord1 w1.Unprotect PWord1 & [- l1 q2 ~& p; H5 |, i4 `Next w1 On Error GoTo 0 % _2 h# G% k4 e, s* ?ShTag = False For Each w1 In Worksheets 0 i1 q& n" B* O; m'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContents Next w1 If ShTag Then ' U" T2 D% }# C1 @4 O5 D! KFor Each w1 In Worksheets ; j3 h' h. o# V1 V5 z, |With w1 If .ProtectContents Then On Error Resume Next Do 'Dummy do loop ) n& U6 R4 q( |" H% vFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 $ t4 T7 E: f0 x; @; XFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 " [; U7 S2 {! f `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) & _ 0 q& l3 X" S* ]7 P O3 UChr(i4) & Chr(i5) & Chr(i6) & Chr(n) 5 i. d% Q! ?! q3 RMsgBox Application.Substitute(MSGPWORDFOUND2, _ "$$", PWord1), vbInformation, HEADER 'leverage finding Pword by trying on other sheets 1 O3 [7 \8 j. F0 xFor Each w2 In Worksheets ; M; }+ ?0 h7 G1 ~% r. lw2.Unprotect PWord1 Next w2 6 q* D8 g4 m' M' y6 aExit Do 'Bypass all for...nexts End If Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next 1 Z( `5 G9 Y& P% M6 MLoop Until True 9 `' O+ t2 O' i3 n3 h% ^% UOn Error GoTo 0 * p% I+ ^- R+ ?7 EEnd If End With / a9 g: d% F$ ]6 t8 INext w1 End If MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER End Sub & L D3 Y4 j' ^ 今天解决的大问题！！