Public Sub 工作表保护密码破解() r0F_;
Const DBLSPACE As String = vbNewLine & vbNewLine RVc)")
hQj
Const AUTHORS As String = DBLSPACE & vbNewLine & _ YXF #c)#
"作者:XXXXXXX" |} _gA
Const HEADER As String = "工作表保护密码破解" O.*jR`l
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" 6xQ"bFm
Const REPBACK As String = DBLSPACE & "" Z0e-W:&;kF
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" sA/,+aM
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ O6yP
qG *j
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" a(8>n
Z,V
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" $d'CBsu|<
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" $brKl 8P
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" =m`l%V[
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ `[WyH O|8
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" CE ~r4
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ 7w "sJ
"如果该文件工作表有不同密码,将搜索下一组密码并解除" f %2%T'Q
Const MSGONLYONE As String = "确保为唯一的?" f5@.^hi[
Dim w1 As Worksheet, w2 As Worksheet 7{n\y l?
Dim i As Integer, j As Integer, k As Integer, l As Integer p QluGIX0V
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer &&X$d!V
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer h ZoC _\
Dim PWord1 As String bt;lq!g
Dim ShTag As Boolean, WinTag As Boolean g-."sniP$g
Application.ScreenUpdating = False fd4;mc1T
With ActiveWorkbook p1Q/g Il
WinTag = .ProtectStructure Or .ProtectWindows Uh|TDuM
End With MWM
+hk1fs
ShTag = False ]{YN{
For Each w1 In Worksheets 3PsxOb+
ShTag = ShTag Or w1.ProtectContents U? 8i'5)
Next w1 P?^JPbfV
If Not ShTag And Not WinTag Then $ "Af y)Ir
MsgBox MSGNOPWORDS1, vbInformation, HEADER mT96 ]V \
Exit Sub -NAmu97V}
End If eh$G.-2N
MsgBox MSGTAKETIME, vbInformation, HEADER ;K3d' U
If Not WinTag Then XjX 2[*l
Else }% eDEM
On Error Resume Next saatU;V
Do 'dummy do loop &oA ~
Tx
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 K<c2PFo)Q
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 hzaU8kb
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 o
g_Ri$x8
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 '.pgXsC:=?
With ActiveWorkbook RNGO~:k?r
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ D899gGe
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ /sy-;JDnsu
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 43KaL(
If .ProtectStructure = False And _ X *0k>j
.ProtectWindows = False Then F 4Rr2 6M
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ X$/E> I
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ _zdNL wE[
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Iq+2mQi*/k
MsgBox Application.Substitute(MSGPWORDFOUND1, _ S# ,+Z7
"$$", PWord1), vbInformation, HEADER I?^aCnU
Exit Do 'Bypass all for...nexts I$n+DwKcN
End If s~L`53A
End With R;WW
f.#
Next: Next: Next: Next: Next: Next $( S*GF$S
Next: Next: Next: Next: Next: Next Q-[3j
Loop Until True J;S-+
On Error GoTo 0 a;%I\w;2
End If (FuEd11R
If WinTag And Not ShTag Then -:MmSeG7gO
MsgBox MSGONLYONE, vbInformation, HEADER {`a(Tl8 V
Exit Sub $u:<x
End If C?,*U
On Error Resume Next R0{ Qy*YQ`
For Each w1 In Worksheets M3ZOk<O<R
'Attempt clearance with PWord1 !6lOIgn
w1.Unprotect PWord1 A*hZv|$0
Next w1 ^D >fis
On Error GoTo 0 T-^0:@5o9
ShTag = False ri: , q/-
For Each w1 In Worksheets sr\cVv")
'Checks for all clear ShTag triggered to 1 if not. '}_=kp'X
ShTag = ShTag Or w1.ProtectContents
4 bn t=5]
Next w1 )&>L !,z
If ShTag Then *t^eNU A
For Each w1 In Worksheets oWI!u 5
With w1 \fTTkpM
If .ProtectContents Then }@wVW))6$
On Error Resume Next L/ ~D<V
Do 'Dummy do loop Q.yb4
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 mIvnz{_d
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 /w0sj`;"
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 Z%#^xCz;w>
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 47 KNT7C
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ iecWa:('
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 8+ov(B;(
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
/^Y[*5
If Not .ProtectContents Then <P - $RX
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ byafb+ x
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Q |%-9^
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) kL|\wci
MsgBox Application.Substitute(MSGPWORDFOUND2, _ Uls+n@\!
"$$", PWord1), vbInformation, HEADER 2SY Ke$e
'leverage finding Pword by trying on other sheets f_rp<R>Uu
For Each w2 In Worksheets EOhC6>ATh
w2.Unprotect PWord1 Wj&nUp{
Next w2 [O\9 9>
Exit Do 'Bypass all for...nexts $|k%@Q >
End If F'1k<V?
Next: Next: Next: Next: Next: Next hq L+_| DW
Next: Next: Next: Next: Next: Next n!ZMTcK8
Loop Until True >
V8sm /M
On Error GoTo 0 mB~~_]M
N
End If M;qBDT~)
End With 6F(hY !}5
Next w1 I`NUurQTX
End If wZQ)jo7*g
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER ? z3]
End Sub ^_sQG
