Public Sub 工作表保护密码破解() <] w(1{q(
Const DBLSPACE As String = vbNewLine & vbNewLine th
:I31
Const AUTHORS As String = DBLSPACE & vbNewLine & _ 'L k& iph
"作者:XXXXXXX" (7zdbJX
Const HEADER As String = "工作表保护密码破解" j Z6]G{
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" %@q/OVnM
Const REPBACK As String = DBLSPACE & "" M94zlW<
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" %B#(d)T*-
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ C<G `wXlP|
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" dRhsnT+KX
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" *X%dg$VcV
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" 2SABu796j
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" J$+K't5BZ
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ BH;7CK=7R
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" Hy n* O)q!
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ h=x{
3P;B
"如果该文件工作表有不同密码,将搜索下一组密码并解除" +t8{aaV
Const MSGONLYONE As String = "确保为唯一的?" s.uw,x
Dim w1 As Worksheet, w2 As Worksheet bdxmJ9a:R
Dim i As Integer, j As Integer, k As Integer, l As Integer QIb4ghm,
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer S&q(PI_"
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer <T^:`p/]4
Dim PWord1 As String >}I BPC
Dim ShTag As Boolean, WinTag As Boolean ?|$IZ9
Application.ScreenUpdating = False ZC!GKW P2
With ActiveWorkbook H)@f_pfj(
WinTag = .ProtectStructure Or .ProtectWindows Fcp8RBq
End With rzk-_AFR
ShTag = False _+0Q Q{'N
For Each w1 In Worksheets H) 5V \
ShTag = ShTag Or w1.ProtectContents Q >QES-.l
Next w1 ^#0k\f>_
If Not ShTag And Not WinTag Then x$gVEh*k
MsgBox MSGNOPWORDS1, vbInformation, HEADER |to| kU
Exit Sub 9) ~Ha iVB
End If sM _m
MsgBox MSGTAKETIME, vbInformation, HEADER .29y3}[PO
If Not WinTag Then +\D?H.P
Else um5n3=K
On Error Resume Next l,w$! FnmR
Do 'dummy do loop D,( "3zx
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 OtsW>L@ O(
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 .$s>b#m O
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 P_y8[ Y]?
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 2<X.kM?N{B
With ActiveWorkbook N5%Cwl6i
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ W&'[Xj
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ M#'j7EMu
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ]N#%exBVo
If .ProtectStructure = False And _ x[m&ILr
.ProtectWindows = False Then &X%vp?p
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ EZw<)Q
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 0D Q\ akh
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) *y@Xm~ld
MsgBox Application.Substitute(MSGPWORDFOUND1, _ -V\$oVS0S
"$$", PWord1), vbInformation, HEADER K:_5#!*^98
Exit Do 'Bypass all for...nexts ~L55l2u7
End If AzlZe\V?)~
End With 'U|Tye i?
Next: Next: Next: Next: Next: Next ~ MZEAY9
Next: Next: Next: Next: Next: Next yr"BeTrS.
Loop Until True )^q7s&p/
On Error GoTo 0 %@Ow.7z h
End If #|ILeby
If WinTag And Not ShTag Then jSKhWxL;'
MsgBox MSGONLYONE, vbInformation, HEADER ))xyaYIZkk
Exit Sub [>#@?@x`P
End If [ ]#>r
k~
On Error Resume Next R 32A2Ml
For Each w1 In Worksheets p@Va`:RDW
'Attempt clearance with PWord1 6.(L8.jv
w1.Unprotect PWord1 ZaKT~f%%z
Next w1 \(g/::|
On Error GoTo 0 lBN1OL[N
ShTag = False m&&Y=2
For Each w1 In Worksheets wx]r {
'Checks for all clear ShTag triggered to 1 if not. R/BW$4/E
ShTag = ShTag Or w1.ProtectContents w /l\ p3n
Next w1 s(u,m tG
If ShTag Then K|Kc.
For Each w1 In Worksheets r }%2;! T
With w1 .9'bi#:Cw
If .ProtectContents Then
,fR /C
On Error Resume Next -l2aAK1M
Do 'Dummy do loop +"8-)'
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 A-GU:B
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 ^h^\kW' #
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 =o? Q0
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 8+=-!": ]
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ eX0ASI9
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ =|Vm69
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ( t%+Z"j
If Not .ProtectContents Then qbZY[Q+F
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ -z6{!
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ YZllfw$9
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) tY>_ +)oi
MsgBox Application.Substitute(MSGPWORDFOUND2, _ P"k`h=>!4
"$$", PWord1), vbInformation, HEADER Ak=|wY{
'leverage finding Pword by trying on other sheets )/4xR]
For Each w2 In Worksheets C#3K.0a
w2.Unprotect PWord1 FcI ZG _
Next w2 ~V`F5B
Exit Do 'Bypass all for...nexts ?K9zTas@
End If 2n3g!M6~
Next: Next: Next: Next: Next: Next =E~)s vl6g
Next: Next: Next: Next: Next: Next S)L(~ N1
Loop Until True |tua*zEsS
On Error GoTo 0 g71|t7Q
End If ;:l >Kac
End With [/'=M h
Next w1 Y [ p
End If *v6 j7<H
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER r{ 1xjA T
End Sub 3^x
C=++
