Public Sub 工作表保护密码破解() %'o'Kh''=
Const DBLSPACE As String = vbNewLine & vbNewLine c6-~PKJL
Const AUTHORS As String = DBLSPACE & vbNewLine & _ f(S 9>c2
"作者:XXXXXXX" D`hl}
Const HEADER As String = "工作表保护密码破解" W=G8l%
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" o{]2W `0r
Const REPBACK As String = DBLSPACE & "" FT8<a }o
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" VcX89c4\
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ !1m7^3l7j
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" H^sImIEUT
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" - 8zdkm8k
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" 7! sR%h5p
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" >uLWfk+y1
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ Nhf@ Y}Cu
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" nz2`YyR
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ &s^t~>G pr
"如果该文件工作表有不同密码,将搜索下一组密码并解除" .o#A(3&n
Const MSGONLYONE As String = "确保为唯一的?" L S:^K
Dim w1 As Worksheet, w2 As Worksheet Nb3uDA5R
Dim i As Integer, j As Integer, k As Integer, l As Integer "50 c<sZSB
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer :;Xh`br
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer M!tR>NMH
Dim PWord1 As String ~~r7T Pq
Dim ShTag As Boolean, WinTag As Boolean &TT vX% T
Application.ScreenUpdating = False W*;r}!ro
With ActiveWorkbook ) S zn,
WinTag = .ProtectStructure Or .ProtectWindows "UY lC0 S\
End With KOhK#t>H@0
ShTag = False b9R0"w!ml
For Each w1 In Worksheets EQ [K
ShTag = ShTag Or w1.ProtectContents nPW=m`jG
Next w1 ^#gJf*'UE
If Not ShTag And Not WinTag Then (&i
c3/-
MsgBox MSGNOPWORDS1, vbInformation, HEADER h~pQ
Exit Sub :8t;_f
End If {[ pzqzL6
MsgBox MSGTAKETIME, vbInformation, HEADER )k[{re
If Not WinTag Then !&adO,jN+=
Else U6?3 z
On Error Resume Next ##6u
Do 'dummy do loop W"!{f
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 {%Rn tb
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 719lfI&s
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 @rP#ktz]
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 U!
$/'Xi9
With ActiveWorkbook a)S{9q} %
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ A'aY H`j
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ ntxaFVD
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ~KYA{^`*
If .ProtectStructure = False And _ \MDhm,H<
.ProtectWindows = False Then RF }R~m9]
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ gq ~K(Q<O<
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ oD3]2o /
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) SFjR SMi
MsgBox Application.Substitute(MSGPWORDFOUND1, _ MX"M2>" pT
"$$", PWord1), vbInformation, HEADER 7Hg;SK6t0
Exit Do 'Bypass all for...nexts 8b"vXNB.f
End If .I I o
End With G:!3X) b
Next: Next: Next: Next: Next: Next #Xk/<It
Next: Next: Next: Next: Next: Next KFBBqP
Loop Until True p`Ok(C_
On Error GoTo 0 .npD<*
End If R8>17w.
If WinTag And Not ShTag Then Tmk'rOg5
MsgBox MSGONLYONE, vbInformation, HEADER
w~~[0e+E
Exit Sub =4uO"o
End If *+% $OH,
On Error Resume Next e7yn" kd
For Each w1 In Worksheets *7{{z%5Pu
'Attempt clearance with PWord1 ! {F\ \D/
w1.Unprotect PWord1 A ;TNR
Next w1 vt#&YXu{A
On Error GoTo 0 aJ J)ZP2+
ShTag = False oXQI"?^+
For Each w1 In Worksheets W[LQ $uj
'Checks for all clear ShTag triggered to 1 if not. FwV 5{-(
ShTag = ShTag Or w1.ProtectContents 79uAsI2-Y
Next w1 A
|P
wm`
If ShTag Then %_(^BZd
For Each w1 In Worksheets 62 o nMY
With w1 ]P2Wa
If .ProtectContents Then E~S~Ld%
On Error Resume Next :j [=
Do 'Dummy do loop Bxf&gDwjgr
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 .7HEI;4
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 n){u!z)Al
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 7yal T.
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 zUA
-
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ |ADg#oX
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ {> d \
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) &23{(]eO
If Not .ProtectContents Then }}LjEOvL=
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ *iUR1V Y
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ c3 )6{
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) m' eM&1Ba
MsgBox Application.Substitute(MSGPWORDFOUND2, _ 2UMX%+ "J
"$$", PWord1), vbInformation, HEADER 8"ulAx74>
'leverage finding Pword by trying on other sheets &S[>*+}{+
For Each w2 In Worksheets t;
@T~%
w2.Unprotect PWord1 )%q )!x
Next w2 #TIlM]5%
Exit Do 'Bypass all for...nexts (r-PkfXvIf
End If g{Hb3id9
Next: Next: Next: Next: Next: Next hM[I}$M&O
Next: Next: Next: Next: Next: Next '/fueku
Loop Until True loD:4e1
On Error GoTo 0 X
CHN'l'
End If ?^U1~5ff)
End With W
. dm1
Next w1 -e.ygiK.`S
End If B7n 1'?
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER ~,{nBp9*
End Sub 17l c5#^L
