EXCEL工作表保护密码破解ZT

某领导

两天前在公司上班网上Q时，见到久违的工作一族的姑姑，她一份重要的工作报表密码遗失...于是我在网上找破解密码的软件，这破解的软件倒是很多，但都不适用，于是...继续搜索。想想念了三年的计算机，学到了什么...真是惭愧无言... 我的工作大部份也是做报表，是公司车辆的信息报表。重要的报表时常有密码保护，与报表密切联系的工作一族很需要知道这些知识，无疑这可以给我们的工作带来方便。 在网上找到了这份破解代码，成功破解了，但不能找到原表的密码，这是最遗憾的。还有破解的表的安全系数会低点。对工作报表一族超级无敌有用！！ 方法: 1\打开文件 8 X& p% M8 Y, `, D9 F3 ^2\工具---宏----录制新宏---输入名字如:aa 3\停止录制(这样得到一个空宏) 5 _* D* Q* W+ o! v: J) |1 R4\工具---宏----宏,选aa,点编辑按钮 Z) B4 X+ H8 [: M z% h5\删除窗口中的所有字符(只有几个),替换为下面的内容复制吧) 6\关闭编辑窗口 7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! 内容如下： Public Sub AllInternalPasswords() / X( V) Z% B( J8 H7 ]0 u" y' Breaks worksheet and workbook structure passwords. Bob McCormick " |+ W7 w1 C) a, q o. h' probably originator of base code algorithm modified for coverage ' of workbook structure / windows passwords and for multiple passwords 6 V; C! t1 M$ k5 Q' E' 6 g" G+ | ?5 V* K; g; c% D' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-Apr-04 by JEM: All msgs to constants, and # z- v3 Y [* J0 ]' 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 & _ % |6 h$ L! B2 R% ?3 U I"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." 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" & _ + ?! w5 b4 M( ]DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ DBLSPACE & "Also, remember that the password was " & _ 8 z J2 q& n" D1 s6 b: e"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 " & _ 7 I! y9 r# W# m8 B4 \0 s"sheets, or workbook structure or windows." & AUTHORS & VERSION & J7 W) c$ a9 W. q, T" oConst MSGNOPWORDS2 As String = "There was no protection to " & _ + ?% ^8 }* ^. m( b. [( x8 g0 v"workbook structure or windows." & DBLSPACE & _ . o* w% K$ b' A- c# x"roceeding to unprotect sheets." & AUTHORS & VERSION 1 `# L H" w5 d" E7 K nConst MSGTAKETIME As String = "After pressing OK button this " & _ - r0 z3 m( E5 F5 M* L! C+ p"will take some time." & DBLSPACE & "Amount of time " & _ "depends on how many different passwords, the " & _ 2 K* O0 v, @7 K1 a% h3 f9 U+ K"passwords, and your computer's specification." & DBLSPACE & _ 9 G" {" v0 K5 F0 x2 a, N"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 & _ $ r; y9 a- d1 Q"Now to check and clear other passwords." & AUTHORS & VERSION Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ 4 Y* g8 u: X3 c) } V"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 ) X% l9 x- V0 X8 Q6 t, XConst MSGONLYONE As String = "Only structure / windows " & _ ; e, {0 Q) }6 O1 Y& `"protected with the password that was just found." & _ ! J; ?8 U( }- YALLCLEAR & AUTHORS & VERSION & REPBACK Dim w1 As Worksheet, w2 As Worksheet * A6 \# ~$ F3 ?- @3 XDim 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 % P+ |6 F) p# T% r# I2 RDim ShTag As Boolean, WinTag As Boolean ( G6 ^( S/ s& N+ T . U5 g7 I5 d- dApplication.ScreenUpdating = False With ActiveWorkbook ( | p6 s, e( c ~WinTag = .ProtectStructure Or .ProtectWindows End With ( H; b$ p2 f/ I+ u s% @' u- U& EShTag = False For Each w1 In Worksheets ! ]; {+ a) X5 K! p+ O. C" L4 XShTag = ShTag Or w1.ProtectContents ! M( j+ d" N; ~6 ~6 ONext w1 , s( q# W" K: ]3 L T, D5 IIf Not ShTag And Not WinTag Then 2 i3 Q. ]" M8 {/ K! XMsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub 6 s3 ^! q W% f0 BEnd If + d n: ^5 ?' X6 c tMsgBox MSGTAKETIME, vbInformation, HEADER If Not WinTag Then MsgBox MSGNOPWORDS2, vbInformation, HEADER z6 T: Y5 f" I2 ~( `+ ?Else " E Z: K R* `3 t7 QOn Error Resume Next Do 'dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 # ^ u; o6 e% T) H9 L2 q7 I0 hFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 " `2 B3 L+ b `9 \# ^, n/ ~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 5 ]/ \0 ?; `3 V6 c! G) G.Unprotect Chr(i) & Chr(j) & Chr(k) & _ ) k- I1 g `% Q# i* t6 ~$ KChr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) + N4 ?2 w, g- y8 ^& KIf .ProtectStructure = False And _ .ProtectWindows = False Then 2 M0 @5 f: {8 r# o5 n3 dPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ * x1 F9 v7 a, S H; @. ^5 y( MChr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND1, _ 0 ~+ m6 S1 n/ H& S7 p1 t, p"$$", PWord1), vbInformation, HEADER ! O$ p6 N# n& ~0 W1 C8 `! GExit 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 " k/ w, |' ^4 s% REnd If ' w& {. k- f* f$ m% @/ `0 qIf WinTag And Not ShTag Then `( t/ L! R6 EMsgBox MSGONLYONE, vbInformation, HEADER * o6 B5 C! b& J) L' x- K$ KExit Sub 9 q" _0 N( B" c) L) O/ x, GEnd If " P$ @) K4 R m. FOn Error Resume Next + Z: \$ v" L) N" B' Q& y( i0 MFor Each w1 In Worksheets + v0 z/ G2 v( x2 x# }( }) Z7 `'Attempt clearance with PWord1 # p3 l' @! ?+ D" O2 xw1.Unprotect PWord1 Next w1 0 w6 ^9 o0 Q; QOn Error GoTo 0 ShTag = False $ M% @9 X: n' ~" ~7 JFor Each w1 In Worksheets 'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContents Next w1 ; g0 g$ q2 f3 n. W1 M/ d9 ~If ShTag Then 2 h' H5 C; E' y7 bFor Each w1 In Worksheets With w1 + z1 k) h& l* F5 G& p$ _( FIf .ProtectContents Then On Error Resume Next Do 'Dummy do loop : P2 S% |( {1 y5 a& |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) & _ ) v3 E& r, @1 RChr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ ; _- ?& E P9 [, q0 r* X; pChr(i4) & Chr(i5) & Chr(i6) & Chr(n) ( {( [ A" g4 D+ E* V9 s& gIf Not .ProtectContents Then 3 [$ ^ D& Y8 l( OPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) % I/ c& L0 N8 r' J. A$ u+ IMsgBox Application.Substitute(MSGPWORDFOUND2, _ "$$", PWord1), vbInformation, HEADER , @4 ^) `5 {3 N% E'leverage finding Pword by trying on other sheets - ^) N0 h$ o3 v6 N1 `3 h s/ K" AFor Each w2 In Worksheets / G2 Z! { ~% D8 A9 Lw2.Unprotect PWord1 & r0 `" e+ y1 O0 ]% r$ y/ ^Next w2 Exit Do 'Bypass all for...nexts + _) R& k0 B' y) \% vEnd If % S" }4 s- k2 QNext: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 8 U' f/ ^0 s O8 U2 qEnd If & \6 z% T X- SEnd With / @3 z, ]# I' U% T: R/ zNext w1 End If ' U/ f- H0 v" F; ]MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER ( S6 T9 s/ J) l1 c1 r; z7 vEnd Sub ; e* V9 c' s) X( Y# H今天解决的大问题！！