EXCEL工作表保护密码破解ZT

某领导

两天前在公司上班网上Q时，见到久违的工作一族的姑姑，她一份重要的工作报表密码遗失...于是我在网上找破解密码的软件，这破解的软件倒是很多，但都不适用，于是...继续搜索。想想念了三年的计算机，学到了什么...真是惭愧无言... 我的工作大部份也是做报表，是公司车辆的信息报表。重要的报表时常有密码保护，与报表密切联系的工作一族很需要知道这些知识，无疑这可以给我们的工作带来方便。 在网上找到了这份破解代码，成功破解了，但不能找到原表的密码，这是最遗憾的。还有破解的表的安全系数会低点。对工作报表一族超级无敌有用！！ 方法: . s9 r( g, ]1 P6 j& A: i1\打开文件 2\工具---宏----录制新宏---输入名字如:aa ; _6 `6 I' C9 D* n% X, c% [3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容复制吧) 6\关闭编辑窗口 8 q; e: b, L0 ^3 E( B2 J7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! L9 H" q) J; d8 T; T' G" P) V" H内容如下： . p. {. g7 x. {1 |. O gPublic Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords. Bob McCormick $ d {- T9 W" K" ] Y4 [' ?' F* Z' probably originator of base code algorithm modified for coverage ' of workbook structure / windows passwords and for multiple passwords ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 0 R4 u' f" Z- C' Modified 2003-Apr-04 by JEM: All msgs to constants, and ! |& C/ n$ T" ~0 T' 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 & _ "Adapted from Bob McCormick base code by" & _ ; t& g3 R9 l4 B& b$ V"Norman Harker and JE McGimpsey" 5 c# G+ |2 P4 p6 ~$ O4 f" kConst HEADER As String = "AllInternalPasswords User Message" * M/ u. p5 |: e( A$ f5 iConst VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" & }& W+ U. k, jConst REPBACK As String = DBLSPACE & "lease report failure " & _ " H& F+ r( m% I7 x"to the microsoft.public.excel.programming newsgroup." " [; M q5 P% u/ H% b% EConst ALLCLEAR As String = DBLSPACE & "The workbook should " & _ # y$ g& \( U- ?8 o"now be free of all password protection, so make sure you:" & _ # T0 J3 k" w/ v- |8 U# t7 k CDBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ ) B: w3 m& j% S. Z7 J9 U9 m- UDBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 5 s, q8 M' V. L% u, O$ \2 y1 s, ~DBLSPACE & "Also, remember that the password was " & _ "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." - H- E4 i& d2 s2 J" oConst MSGNOPWORDS1 As String = "There were no passwords on " & _ "sheets, or workbook structure or windows." & AUTHORS & VERSION Const MSGNOPWORDS2 As String = "There was no protection to " & _ 9 X- v, E* o- [3 Q4 x5 c- D"workbook structure or windows." & DBLSPACE & _ # F: }5 B. J* _. r( P# a"roceeding to unprotect sheets." & AUTHORS & VERSION Const MSGTAKETIME As String = "After pressing OK button this " & _ "will take some time." & DBLSPACE & "Amount of time " & _ "depends on how many different passwords, the " & _ , L& q0 I1 |- \- y6 J: ]0 E3 h3 ~"passwords, and your computer's specification." & DBLSPACE & _ # S8 z! n9 b/ N4 Y"Just be patient! Make me a coffee!" & AUTHORS & VERSION Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ & J( y/ t5 C7 J& n"Structure or Windows Password set." & DBLSPACE & _ "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ 3 K/ X" h- H/ ^4 s+ T"Note it down for potential future use in other workbooks by " & _ 4 v* z" r4 ~. p& u5 S ?: t"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 " & _ % M4 P; {# f* {1 J+ x E* m"password set." & DBLSPACE & "The password found was: " & _ ' M8 c1 b3 M, lDBLSPACE & "$$" & 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 % l- i1 u% I& a( @3 W( b" oConst MSGONLYONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ $ L4 D' ]; N( n* x# @( _ALLCLEAR & AUTHORS & VERSION & REPBACK ) M7 m: M5 n# S$ `Dim w1 As Worksheet, w2 As Worksheet Dim 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 ! T% j& ~5 K2 J' c0 D# K2 kDim ShTag As Boolean, WinTag As Boolean ) j* ^5 e9 Z# `6 ?, K! wApplication.ScreenUpdating = False With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows End With 5 p/ @9 `5 }4 g# TShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag And Not WinTag Then . Q+ w6 U: I& h# g* |MsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub End If 3 j5 e# Z1 y! {/ Q5 vMsgBox MSGTAKETIME, vbInformation, HEADER ! M1 s- j% h; Y4 e4 VIf Not WinTag Then MsgBox MSGNOPWORDS2, vbInformation, HEADER . {6 ]% p5 A! I8 eElse $ O- H' q) {6 n" ^6 xOn Error Resume Next " M6 |% f. k# `) E+ q) v& T& [Do 'dummy do loop 4 O6 n) s( B5 l) kFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 % {2 ?* M8 s9 u% B" w0 \; QFor 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 0 B$ c f3 F) x9 J! xWith ActiveWorkbook 1 T5 S @" Q t# c- k6 w.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 .ProtectStructure = False And _ .ProtectWindows = False Then 0 c. ?3 r0 }: L* U( ^# RPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ , r- |# p" P; l( n# ]9 P( T5 qChr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND1, _ : z9 y/ P7 x0 U* a3 A"$$", PWord1), vbInformation, HEADER Exit Do 'Bypass all for...nexts End If ) f, I! a9 U' X0 R9 M6 E2 xEnd With Next: Next: Next: Next: Next: Next 7 P+ B& Q x0 D' F* ONext: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 ; g. S* r l( a: i4 b. K6 NEnd If If WinTag And Not ShTag Then MsgBox MSGONLYONE, vbInformation, HEADER / x# W6 n" j% }) n; F( _1 \+ k% }Exit Sub , ?5 }/ L0 z0 E' u7 k; e+ Y) dEnd If 9 B: u {: p$ ~, X+ ^% n XOn Error Resume Next W) s2 s: `$ H' H+ KFor Each w1 In Worksheets 6 z6 S' j7 Z. Y; H6 ], X'Attempt clearance with PWord1 w1.Unprotect PWord1 Next w1 6 r8 {& W4 q3 |! }* Q6 |7 O# ZOn Error GoTo 0 # c B: X# U2 o8 qShTag = False t2 L6 V- U& w) p- EFor Each w1 In Worksheets 'Checks for all clear ShTag triggered to 1 if not. # e# f9 R1 W3 EShTag = ShTag Or w1.ProtectContents 5 r" h1 {! C9 v2 R6 C xNext w1 If ShTag Then For Each w1 In Worksheets 7 L, G* j+ M4 f" Y1 W+ UWith w1 If .ProtectContents Then On Error Resume Next ; m; C( Q2 o- o. p0 ~ yDo 'Dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 ) Y. n: I: w% G2 x& d8 QFor 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) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 0 V# G. h6 Q1 V* b" r; c$ C7 tChr(i4) & Chr(i5) & Chr(i6) & Chr(n) - d0 l! Q0 y3 O: V5 ~6 U5 `If Not .ProtectContents Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ ) K; Y" D* I# G; `Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) $ `3 C. C1 t7 x! t/ |2 NMsgBox Application.Substitute(MSGPWORDFOUND2, _ 3 {3 r9 s3 S% L* h3 ?8 Q$ w$ ~5 B"$$", PWord1), vbInformation, HEADER $ I# Z! N( K& Q& [: l'leverage finding Pword by trying on other sheets For Each w2 In Worksheets $ C, O2 a+ Y* [0 W5 h/ Bw2.Unprotect PWord1 + `6 |/ n( T% A$ s- S1 HNext w2 . J+ k: R6 P! \" y3 p4 B3 dExit Do 'Bypass all for...nexts End If 2 k) z" g6 j' t' [' p3 dNext: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If ) u# a: T% N9 e; TEnd With Next w1 End If MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER # p# Q5 b7 Q N/ y3 aEnd Sub % A: ]6 Y0 B0 G/ F' W今天解决的大问题！！