Public Sub 工作表保护密码破解() k$VlfQ'+
Const DBLSPACE As String = vbNewLine & vbNewLine }>\C{ClI
Const AUTHORS As String = DBLSPACE & vbNewLine & _ kh<2BOV
"作者:XXXXXXX" ctQ/wrkU
Const HEADER As String = "工作表保护密码破解" :jf3HG
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" &{:-]g\
Const REPBACK As String = DBLSPACE & "" " bG2:
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" PT
~D",k
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ G@0&8
& DBLSPACE & "注意:不要用在不当地方,要尊重他人的劳动成果!" sOY:e/_F
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" A/(a`"mK|'
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" _c07}aQ ],
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" ib m4fa
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ (7Qo
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" hH.G#-JO
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ Jm@oDME_E
"如果该文件工作表有不同密码,将搜索下一组密码并解除" 4H/OBR
Const MSGONLYONE As String = "确保为唯一的?" SbZ6t$"
Dim w1 As Worksheet, w2 As Worksheet )b)zm2;
Dim i As Integer, j As Integer, k As Integer, l As Integer /v}`l
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer *8q.YuZ
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer +ZYn? #IQ
Dim PWord1 As String @EAbF>>
Dim ShTag As Boolean, WinTag As Boolean P>T"cv
Application.ScreenUpdating = False NK+o1
With ActiveWorkbook KvSG;
WinTag = .ProtectStructure Or .ProtectWindows ooGM$U
End With }H4RR}g
ShTag = False %O<BfIZ
For Each w1 In Worksheets ]9-\~Mwh
ShTag = ShTag Or w1.ProtectContents 2oW"'43X
Next w1 XW9!p.*.U
If Not ShTag And Not WinTag Then Kw}'W
8`c
MsgBox MSGNOPWORDS1, vbInformation, HEADER nN;u,}e
Exit Sub zs;JJk^
End If a*;b^Ze`v
MsgBox MSGTAKETIME, vbInformation, HEADER CTK;dM'uQ
If Not WinTag Then *Ex|9FCt$
Else 1YA% -~
On Error Resume Next GbyJ:
Do 'dummy do loop Ac6=(B
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 & kIFcd@
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 :&Nbw
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 $]1=\I
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 6*?F@D2&
With ActiveWorkbook $>gFf}#C
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ E^PB)D(.
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ 6@o*xK7L
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) POW>~Tof1
If .ProtectStructure = False And _ QJNFA}*>
.ProtectWindows = False Then \v{=gK
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ V~bD)?M
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ X]=t>
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) TC. ,V_
MsgBox Application.Substitute(MSGPWORDFOUND1, _ (hsl~Jf
"$$", PWord1), vbInformation, HEADER )"LJ
hLg
Exit Do 'Bypass all for...nexts m|# y
>4
End If Cw%{G'O
End With c,22*.V/
Next: Next: Next: Next: Next: Next zi:BF60]=
Next: Next: Next: Next: Next: Next g0
[w-?f
Loop Until True .hiSw
On Error GoTo 0 -di o5a
End If mmsPLv6
If WinTag And Not ShTag Then ;=@0'xPEa-
MsgBox MSGONLYONE, vbInformation, HEADER -8Xf0_
Exit Sub iLz@5Zj8
End If 2tLJU Z1
On Error Resume Next n(Uyz`qE
For Each w1 In Worksheets F/Pep?'
'Attempt clearance with PWord1 }%z
w1.Unprotect PWord1 Wm|lSisY
Next w1 /bEAK-
On Error GoTo 0 :KN-F86i
ShTag = False 6RM/GM
For Each w1 In Worksheets q;U,s)Uz^
'Checks for all clear ShTag triggered to 1 if not. sGb{9.WK
ShTag = ShTag Or w1.ProtectContents ~Z+%d9ode
Next w1 q=G+Tocv
If ShTag Then -hV*EPQ/
For Each w1 In Worksheets 9cgUT@a
With w1 zJXplvaL;
If .ProtectContents Then ca}2TT&t
On Error Resume Next -+5>|N#
Do 'Dummy do loop OTp]Xe/
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 \1`O_DF~o
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 j4b4!^fV
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 {T8Kk)L
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 @KA4N`
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ V:27)]q
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ ':}\4j&{E
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) jtc~DL
If Not .ProtectContents Then b2]Kx&!
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ bfO=;S]b!
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ qNr}
\J|
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 9Ee'Cm
MsgBox Application.Substitute(MSGPWORDFOUND2, _ uocGbi:V';
"$$", PWord1), vbInformation, HEADER w:l"\Tm
'leverage finding Pword by trying on other sheets P_dJZ((X
For Each w2 In Worksheets a6H%5N
w2.Unprotect PWord1 TKjFp%
Next w2 e*!kZAf
Exit Do 'Bypass all for...nexts ?8 {"x8W;
End If m3ff;,
Next: Next: Next: Next: Next: Next {^'HL
Next: Next: Next: Next: Next: Next _wOt39e&
Loop Until True +)?J#g
On Error GoTo 0 Ha ]YJ}
End If kR9-8I{J
End With -F92-jBM4
Next w1 7Qsgys#/=
End If �{x7,
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER iCyfOh
End Sub Ha#>G<;n