EXCEL工作表保护密码破解ZT

某领导

两天前在公司上班网上Q时，见到久违的工作一族的姑姑，她一份重要的工作报表密码遗失...于是我在网上找破解密码的软件，这破解的软件倒是很多，但都不适用，于是...继续搜索。想想念了三年的计算机，学到了什么...真是惭愧无言... 我的工作大部份也是做报表，是公司车辆的信息报表。重要的报表时常有密码保护，与报表密切联系的工作一族很需要知道这些知识，无疑这可以给我们的工作带来方便。 在网上找到了这份破解代码，成功破解了，但不能找到原表的密码，这是最遗憾的。还有破解的表的安全系数会低点。对工作报表一族超级无敌有用！！ 方法: 1\打开文件 ( z. l# I. J1 V! G2\工具---宏----录制新宏---输入名字如:aa 3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容复制吧) 6\关闭编辑窗口 ( m( }4 o' T; i8 t; G3 }7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! ; e+ C4 b6 J G2 {# w7 \内容如下： 9 p: Y! k7 U P: c. z% OPublic Sub AllInternalPasswords() + y- C" x; e, ^ N3 r" w) u% B' 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 ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-Apr-04 by JEM: All msgs to constants, and , ~/ @ q; y ^5 `' eliminate one Exit Sub (Version 1.1.1) ' Reveals hashed passwords NOT original passwords + i( _9 D4 ?" U1 j9 Y' d- d! H2 }Const DBLSPACE As String = vbNewLine & vbNewLine 6 b" ]8 V7 e$ M8 _. pConst AUTHORS As String = DBLSPACE & vbNewLine & _ "Adapted from Bob McCormick base code by" & _ & E3 z* `; I6 L# d1 D @- u"Norman Harker and JE McGimpsey" 4 X- C) N+ }+ f# Q- G# E) GConst 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 " & _ 0 `4 L8 q) o4 { 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:" & _ DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ , q. j+ m1 a% F% A" w" XDBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ : ^+ m% c- _. x9 qDBLSPACE & "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 " & _ 4 Z( c, x! d; N$ _ }1 R( z"may be an offense. If in doubt, don't." Const MSGNOPWORDS1 As String = "There were no passwords on " & _ : g0 m. [5 t0 `. a"sheets, or workbook structure or windows." & AUTHORS & VERSION ! R+ q4 L1 v1 \1 `6 A6 P) _Const MSGNOPWORDS2 As String = "There was no protection to " & _ "workbook structure or windows." & DBLSPACE & _ 6 O, V9 L1 Z# @# ]+ v- s5 A4 s d"roceeding to unprotect sheets." & AUTHORS & VERSION Const MSGTAKETIME As String = "After pressing OK button this " & _ "will take some time." & DBLSPACE & "Amount of time " & _ 7 u9 } {, j( J9 A, `"depends on how many different passwords, the " & _ + S c6 p1 q3 N' }" W2 N"passwords, and your computer's specification." & DBLSPACE & _ ' X2 @' G1 I" V"Just be patient! Make me a coffee!" & AUTHORS & VERSION 9 _; K3 m3 @' m" K/ qConst MSGPWORDFOUND1 As String = "You had a Worksheet " & _ / r2 x* c6 v3 R% C"Structure or Windows Password set." & DBLSPACE & _ "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ "Note it down for potential future use in other workbooks by " & _ # I! `0 e- x# T+ h"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 " & _ 4 I5 m* u+ ~0 y% G) U" X"password set." & DBLSPACE & "The password found was: " & _ DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ 3 Y1 E" j! W$ e6 b$ x! v"future use in other workbooks by same person who " & _ 8 m$ U# t' d, }9 H4 {! l"set this password." & DBLSPACE & "Now to check and clear " & _ 6 ^4 u( W) Y% N, b7 ["other passwords." & AUTHORS & VERSION Const MSGONLYONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ 7 i8 N' ]! o* {1 A0 H XALLCLEAR & AUTHORS & VERSION & REPBACK # g" ~2 }( ?( X! \; ]# o5 h" VDim w1 As Worksheet, w2 As Worksheet 5 ^' D* w: B; p0 F6 N& w ~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 ' O6 ?# s4 c+ xDim ShTag As Boolean, WinTag As Boolean " Y7 c4 H1 o9 H7 G O" v. KApplication.ScreenUpdating = False With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows End With & k2 c7 f' p3 q; lShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents O- g% R7 T9 l$ qNext w1 2 e* m5 n' Q/ l7 wIf Not ShTag And Not WinTag Then , ~/ p" e7 T. {8 H) EMsgBox MSGNOPWORDS1, vbInformation, HEADER ' O9 \8 L O5 p& X- d! vExit Sub 6 {0 q6 E8 j/ a' r aEnd If MsgBox MSGTAKETIME, vbInformation, HEADER ; g2 r, t! }& H2 d# X% CIf Not WinTag Then Q: o3 I$ }+ F) b5 T, }! r7 T" LMsgBox MSGNOPWORDS2, vbInformation, HEADER Else On Error Resume Next Do 'dummy do loop ( F+ G0 Y) b9 B, PFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 7 \. L& V; b7 b. _- E9 P& YFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 " E" ^/ A- j( M1 N. A7 } gFor i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 " p' R% x% C5 q( ?' E& e8 {( mFor 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) 3 h6 A% {/ d* H5 q# e( jIf .ProtectStructure = False And _ 1 ?2 N0 z3 X5 k# Z.ProtectWindows = False Then 8 E% M, p& x% R x! s/ h5 F1 FPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 9 }' }8 _; O+ m" w% \' NChr(i4) & Chr(i5) & Chr(i6) & Chr(n) % A$ m* b1 t5 f; E) tMsgBox Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER Exit Do 'Bypass all for...nexts + W& p& H% S) n+ UEnd If 9 d* M M6 C* cEnd With Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next % V0 U2 J9 X, T+ i/ p; ^Loop Until True : M9 }) n9 W; b4 I% E: |On Error GoTo 0 End If 3 j) G1 N5 O, k- R( S; SIf WinTag And Not ShTag Then 8 E+ _7 g7 }5 H# U* nMsgBox MSGONLYONE, vbInformation, HEADER ) X' M5 f. _+ `+ i3 WExit Sub 2 i7 _1 q* j3 M5 nEnd If 8 M& ^, H. j" V# n+ m9 \2 kOn Error Resume Next : m% F' l6 r# TFor Each w1 In Worksheets 3 ^! \6 w; I! D+ H4 Q% ?2 a$ G'Attempt clearance with PWord1 w1.Unprotect PWord1 . s, F! p/ K9 A# w2 xNext w1 On Error GoTo 0 6 K. a- j3 q3 R( _+ N4 t+ F- V" gShTag = False 7 r+ s$ j2 e5 Q8 J8 ~For Each w1 In Worksheets - ?5 \( H% l* U! G# W% o$ X'Checks for all clear ShTag triggered to 1 if not. % o. j! \" y. E8 v$ D1 [! tShTag = ShTag Or w1.ProtectContents Next w1 If ShTag Then " y- @) @7 e: ]! \ v CFor Each w1 In Worksheets With w1 $ ?3 @) v" I# e3 D4 q# X6 hIf .ProtectContents Then - F3 E2 z; i8 R$ GOn Error Resume Next : Z; Q; ~) D |) eDo 'Dummy do loop & ]! g: D+ a5 ~+ u+ EFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 - ^1 X F* g+ q2 v% Z4 \" c: jFor 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 ( D& O$ K: T l.Unprotect Chr(i) & Chr(j) & Chr(k) & _ ' k0 N- Q9 ~: x0 T* c0 w; YChr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ : q3 n6 E6 M7 g3 XChr(i4) & Chr(i5) & Chr(i6) & Chr(n) If Not .ProtectContents Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ $ j& Q6 t5 F4 @; L" NChr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND2, _ " F2 i4 j+ f7 l. c"$$", PWord1), vbInformation, HEADER : ^/ G, p' L1 J: ?' ^+ o- n'leverage finding Pword by trying on other sheets For Each w2 In Worksheets w2.Unprotect PWord1 Next w2 * I& r( Q2 K. G) _. `Exit Do 'Bypass all for...nexts 2 [* T7 U" w6 F4 Y: i2 bEnd If Next: Next: Next: Next: Next: Next ; A! J5 C# f) {. g! Y/ e, oNext: Next: Next: Next: Next: Next 9 U2 f+ E: Z! W6 J' ^- o& bLoop Until True On Error GoTo 0 # A# f; `& h+ P* ~8 pEnd If End With ( J0 c% f {2 `0 FNext w1 ( T: E$ a8 E( C: XEnd If MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 1 B% v# M8 P6 a5 R' U" KEnd Sub * x, c( Z* c7 Z 今天解决的大问题！！