EXCEL工作表保护密码破解ZT

某领导

两天前在公司上班网上Q时，见到久违的工作一族的姑姑，她一份重要的工作报表密码遗失...于是我在网上找破解密码的软件，这破解的软件倒是很多，但都不适用，于是...继续搜索。想想念了三年的计算机，学到了什么...真是惭愧无言... 我的工作大部份也是做报表，是公司车辆的信息报表。重要的报表时常有密码保护，与报表密切联系的工作一族很需要知道这些知识，无疑这可以给我们的工作带来方便。 在网上找到了这份破解代码，成功破解了，但不能找到原表的密码，这是最遗憾的。还有破解的表的安全系数会低点。对工作报表一族超级无敌有用！！ 方法: 1\打开文件 / b7 i5 e$ A3 N" }2\工具---宏----录制新宏---输入名字如:aa 0 J" J$ F+ D4 U: f5 N- z4 B* Q3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容复制吧) 5 z* u: s* P: B; k. V1 d6\关闭编辑窗口 7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! 内容如下： ; @% X% |# ?* n2 K# h6 _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 ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) {+ S: [& ~8 W+ H8 ]# z2 O' Modified 2003-Apr-04 by JEM: All msgs to constants, and 9 `6 T. p. d6 C; l0 B' eliminate one Exit Sub (Version 1.1.1) ]' K( X9 N: _* C9 \' Reveals hashed passwords NOT original passwords 2 o9 p/ ~; x4 JConst DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE & vbNewLine & _ "Adapted from Bob McCormick base code by" & _ # Q, a# f9 o. Q"Norman Harker and JE McGimpsey" Const HEADER As String = "AllInternalPasswords User Message" + W* w; y/ ?% P7 wConst 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:" & _ - H* A' A# L# m4 q" w; x4 kDBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ / b& g5 e) M- {1 ^ SDBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 4 j) W7 J5 [" V% Q" z% QDBLSPACE & "Also, remember that the password was " & _ ) E8 v* A$ `6 e& D) N4 U' ^"put there for a reason. Don't stuff up crucial formulas " & _ ; X2 {# x. Z5 d"or data." & DBLSPACE & "Access and use of some data " & _ , T$ U! l' Q: f* @$ `"may be an offense. If in doubt, don't." Const MSGNOPWORDS1 As String = "There were no passwords on " & _ "sheets, or workbook structure or windows." & AUTHORS & VERSION 4 n; |3 ~, Y0 L; `! LConst MSGNOPWORDS2 As String = "There was no protection to " & _ / o) d- s3 Q$ H1 p"workbook structure or windows." & DBLSPACE & _ "roceeding to unprotect sheets." & AUTHORS & VERSION Const MSGTAKETIME As String = "After pressing OK button this " & _ "will take some time." & DBLSPACE & "Amount of time " & _ % `6 Q% j. h& r/ ~- A$ Y$ w4 A8 f; b"depends on how many different passwords, the " & _ ! `% b6 E" r7 I"passwords, and your computer's specification." & DBLSPACE & _ 4 E3 Q n) q1 o; X"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 & _ "Now to check and clear other passwords." & AUTHORS & VERSION Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ 9 E+ Z( ~& b3 t7 ]" k Q"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 Const MSGONLYONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ + H$ |% s0 n$ ?% uALLCLEAR & AUTHORS & VERSION & REPBACK t; ]; l5 ~* w( E' v8 X3 \ O% h. a1 ]* eDim w1 As Worksheet, w2 As Worksheet Dim i As Integer, j As Integer, k As Integer, l As Integer , E* m0 V" r3 J4 HDim m As Integer, n As Integer, i1 As Integer, i2 As Integer # h1 }) f+ k# t% g9 M, u4 E* Q8 dDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer ( r3 Q0 w0 v; D% @Dim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean Application.ScreenUpdating = False With ActiveWorkbook - @& R! `2 \3 H/ r! f/ SWinTag = .ProtectStructure Or .ProtectWindows % V9 C# M2 Q, x2 H* l, {! K1 F- d3 sEnd With ShTag = False $ g* N r7 [& A: _+ S) m6 k* E a/ NFor Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents & j1 |: m, ^3 m, UNext w1 + u1 `0 o/ V* t: C5 AIf Not ShTag And Not WinTag Then MsgBox MSGNOPWORDS1, vbInformation, HEADER ! Y( L& w& c4 M3 y' g. RExit Sub End If % W/ S1 T1 A, g& l: e% KMsgBox MSGTAKETIME, vbInformation, HEADER + I3 ?- v7 }* \2 P2 C0 z7 h' nIf Not WinTag Then & }+ ?) D; F" a$ O, ~& cMsgBox MSGNOPWORDS2, vbInformation, HEADER 3 S/ _5 K' s' R$ X8 e! e' ZElse 2 d0 k/ V" `: h8 W; @- oOn Error Resume Next Do 'dummy do loop 3 v! l$ w0 G7 t4 MFor 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 , z, r6 ?) ?! r1 cFor i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 ) ?) J \ ]3 E& J% T: v+ @With ActiveWorkbook & h4 |) n8 Q/ d.Unprotect Chr(i) & Chr(j) & Chr(k) & _ , {; j7 W+ I& OChr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ $ s7 v7 g+ g0 ?1 t8 J: x: K. EChr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) m. H# B% g+ c; d; Q J) VIf .ProtectStructure = False And _ - |8 G/ O! z2 ].ProtectWindows = False Then 6 S' Y# U6 P8 {7 {PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 3 G1 @% y4 d/ t( K! `Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 1 {5 [% S" L6 L9 aChr(i4) & Chr(i5) & Chr(i6) & Chr(n) 8 \( Z0 I0 c1 w% EMsgBox Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER * U) p" w- A: ~; d. gExit Do 'Bypass all for...nexts 8 m0 }# l3 u: k7 {9 @ bEnd If 8 H2 S3 T4 b4 _. f6 H8 t& r% D! N' UEnd With , }" i. t0 a" @8 UNext: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 $ _* |0 K8 M c7 h( ^) C ?( w' GEnd If If WinTag And Not ShTag Then MsgBox MSGONLYONE, vbInformation, HEADER Exit Sub 2 S9 y4 F5 X( w8 iEnd If # g$ ] W' P6 m4 {: b: ZOn Error Resume Next For Each w1 In Worksheets 1 i8 o4 ~0 P9 I/ {! F'Attempt clearance with PWord1 7 {; u4 G/ j( n4 Q# k3 @0 xw1.Unprotect PWord1 Next w1 On Error GoTo 0 / k! n+ V k+ D0 \7 t3 p! BShTag = False . l- [* x; ?3 g+ j- M" k* v4 @For Each w1 In Worksheets 6 ]- L3 m: N- [# h! o'Checks for all clear ShTag triggered to 1 if not. 2 u6 ^" m- F) l% xShTag = ShTag Or w1.ProtectContents Next w1 ! J; o' P) ^0 K. K& QIf ShTag Then ) @& ]$ ~0 a1 I |$ ^4 x* bFor Each w1 In Worksheets # N% A/ H% o- a f- RWith w1 If .ProtectContents Then + |/ h% S4 V2 ~# IOn Error Resume Next # q9 D4 p. i! x) l, N/ iDo 'Dummy do loop # l2 I: p' z0 a) oFor 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 0 K; e& E! u1 W& y7 p6 W" S' QFor i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 2 U) K* t9 p5 j9 ^9 o1 o M.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 2 x9 J* O* G: e# dChr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 3 F( {! \, D* ^. YChr(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) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND2, _ 1 e* j U1 {$ ?1 K0 \: d"$$", PWord1), vbInformation, HEADER 'leverage finding Pword by trying on other sheets : E# c1 ^* f1 _% i7 s+ L- }For Each w2 In Worksheets , c# l G/ c! E! j0 P+ Yw2.Unprotect PWord1 Next w2 Exit Do 'Bypass all for...nexts End If ! ]! F) E% b8 `7 INext: Next: Next: Next: Next: Next , [9 @0 K5 g8 n& a/ N; {. QNext: Next: Next: Next: Next: Next : v2 G; u# Q8 E+ ^Loop Until True On Error GoTo 0 4 z3 ?( D$ X* a: q# sEnd If 7 B/ g) [& z" |/ V0 ]- ~% }$ |End With Next w1 End If 6 w: |& l5 C0 t# U% mMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER End Sub $ @ a, L" Y) e/ q M. @今天解决的大问题！！