Public Sub 工作表保护密码破解() bFe+m1Q_
Const DBLSPACE As String = vbNewLine & vbNewLine |<:vY
Const AUTHORS As String = DBLSPACE & vbNewLine & _ 4"gM <z
"作者:XXXXXXX" $ s9Vrw0Z
Const HEADER As String = "工作表保护密码破解" #Q2Y&2`yGT
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" e,t(q(L
Const REPBACK As String = DBLSPACE & "" UrqRx?#
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" ?>I;34tL(
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ 6Yx4lW BR?
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" G 6T_O
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" -$\+ '
\
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" .zi_[
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" zT!drq: x
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ ]H`1F1=
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" &*+'>UEe5
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ :A/d to
"如果该文件工作表有不同密码,将搜索下一组密码并解除" vQ;Ex
Const MSGONLYONE As String = "确保为唯一的?" Z'"tB/ =W
Dim w1 As Worksheet, w2 As Worksheet .Y&)4+ckL
Dim i As Integer, j As Integer, k As Integer, l As Integer <StN%2WQ1
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer z6*X%6,8
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer ,P;Pm68V
Dim PWord1 As String r>o63Q:
Dim ShTag As Boolean, WinTag As Boolean `$ 6rz
Application.ScreenUpdating = False '.:z&gSqx0
With ActiveWorkbook 7pe\M/kl
WinTag = .ProtectStructure Or .ProtectWindows <
jJ
End With "N`[r iq{
ShTag = False 59h)-^!
For Each w1 In Worksheets G3Z)Z) N
ShTag = ShTag Or w1.ProtectContents &5yV xL:
Next w1 # 1OOU
If Not ShTag And Not WinTag Then bbE!qk;hEP
MsgBox MSGNOPWORDS1, vbInformation, HEADER U|jSa,}
Exit Sub P G qQ@6B
End If \W~ N
MsgBox MSGTAKETIME, vbInformation, HEADER ,J+}rPe"sf
If Not WinTag Then Zy`m!]G]80
Else $g> IyT[
On Error Resume Next :tV*7S=)
Do 'dummy do loop ]s<[D$ <,
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 Y3Yz)T}UkS
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 \NPmym_ 6J
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 VK m&iidU
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 ;ub;l h 3
With ActiveWorkbook ].-1v5
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ uXn1
'K<'2
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ y
[}.yyye
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 8A##\j )
If .ProtectStructure = False And _ ,Lr. 9I.
.ProtectWindows = False Then CsGx@\jN
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 8\+uec]k
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ xi~ ?>f
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) l+KY)6o
MsgBox Application.Substitute(MSGPWORDFOUND1, _ zdB^S%cztS
"$$", PWord1), vbInformation, HEADER !fE`4< |?
Exit Do 'Bypass all for...nexts m*&]!mM"0G
End If 01t1 Z}!y
End With d,k!qjf=r
Next: Next: Next: Next: Next: Next p`olCp'
Next: Next: Next: Next: Next: Next P3x8UR=fS
Loop Until True 6' k<+IR
On Error GoTo 0 =^M/{51j
End If DX#Nf""Pw
If WinTag And Not ShTag Then Ag-(5:
MsgBox MSGONLYONE, vbInformation, HEADER we;-~A5J
Exit Sub 9+Np4i@
End If fDv2JdiU
On Error Resume Next luh$2 \5B
For Each w1 In Worksheets 3c-GY:VkLM
'Attempt clearance with PWord1 &* M!lxDN
w1.Unprotect PWord1 ]C!gQq2'a
Next w1 I9|mG '
On Error GoTo 0 f\|w '
ShTag = False o_izl \
For Each w1 In Worksheets i1 }:8Unxf
'Checks for all clear ShTag triggered to 1 if not. t% d Z-Ym
ShTag = ShTag Or w1.ProtectContents LBw1g<&
Next w1 cN/6SGHK
If ShTag Then >^u2cAi3[
For Each w1 In Worksheets .]8ZwAs=&
With w1 n1Yp1"2b[
If .ProtectContents Then qU \w=
On Error Resume Next
Vr3Zu{&2
Do 'Dummy do loop `+]Qz =}
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 *3+4[WT0]a
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 R$R *'l
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 \j$&DCv
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 Hus)c3Ty7
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ <$D`Z-6
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ L^1NY3=$
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) P\E<9*V
If Not .ProtectContents Then LQ@"Xe]5
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ #|uCgdi
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 0CHH)Bku
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) xK>*yV
MsgBox Application.Substitute(MSGPWORDFOUND2, _ N DN7[ 7E
"$$", PWord1), vbInformation, HEADER P0;n9>g
'leverage finding Pword by trying on other sheets %Hu5K>ZNYp
For Each w2 In Worksheets pIc#L>{E
w2.Unprotect PWord1 p?02C# p
Next w2 = }~hWL
Exit Do 'Bypass all for...nexts >R'F,
End If Lc}y<=P@
Next: Next: Next: Next: Next: Next 6,pnw
Next: Next: Next: Next: Next: Next ,V7nzhA2
Loop Until True Z3Og=XHR
On Error GoTo 0 l5~os >
End If 4VHn \
End With 1a/++4O.|
Next w1 y#`tgJ:
End If G?yLo 'Ulo
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER @="Pn5<]C
End Sub |44Ploz2b
