Public Sub 工作表保护密码破解() `#rfp
9w
Const DBLSPACE As String = vbNewLine & vbNewLine !C#RW=h9
Const AUTHORS As String = DBLSPACE & vbNewLine & _ fmJW d|
"作者:XXXXXXX" pV6HQ:y1
Const HEADER As String = "工作表保护密码破解" \+3Wd$ I
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" n\-_i2yy
Const REPBACK As String = DBLSPACE & "" CFm1c1%Hg
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" D:E~yh) $-
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ EQ7n'Wqq
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" BozK!"R_<
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" o0G`Xn
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" %vt SeJ
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" 4nH91Z9=
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ E`fss d~
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" 3Jm'q,T C
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ /: `
i%E
"如果该文件工作表有不同密码,将搜索下一组密码并解除" %^=!s
Const MSGONLYONE As String = "确保为唯一的?" 0; v~5|r
Dim w1 As Worksheet, w2 As Worksheet Ue#yDTjc
Dim i As Integer, j As Integer, k As Integer, l As Integer ky[Xf -9#
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer `Kw"XGT
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer : W^\
mH
Dim PWord1 As String cIvYfgIo9
Dim ShTag As Boolean, WinTag As Boolean 0@K:Tq-mF
Application.ScreenUpdating = False [4Faq3T"
With ActiveWorkbook _P<l G[V
WinTag = .ProtectStructure Or .ProtectWindows @CU|3Qg
End With M`P]cX)x
ShTag = False qH
Ga
For Each w1 In Worksheets > &vO4L
ShTag = ShTag Or w1.ProtectContents yVI;s|jG
Next w1 <
}wAP_y
If Not ShTag And Not WinTag Then i!W8Q$V
MsgBox MSGNOPWORDS1, vbInformation, HEADER @zynqh
Exit Sub ~}IvY?! ;
End If C^ " Hj
MsgBox MSGTAKETIME, vbInformation, HEADER y)/$ge _U
If Not WinTag Then /QXs-T}d
Else L%K_.!d^
On Error Resume Next tOM3Gs~o6z
Do 'dummy do loop <W51 oO
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 StZRc\k
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 @=0r3
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 BgWz<k}5M
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 C6'*/wq
With ActiveWorkbook PyT}}UKj:
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ \+Rwm:lI
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ + %#MrNM'
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) nn)` eR&
If .ProtectStructure = False And _ 4 ?@uF[
.ProtectWindows = False Then j t`p<gI
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 5Vqmv<F;$Z
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ CoUd16*"JM
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) J7?)$,ij%
MsgBox Application.Substitute(MSGPWORDFOUND1, _ Iq0 #A5U%
"$$", PWord1), vbInformation, HEADER LbV]JP
Exit Do 'Bypass all for...nexts ^[seK)S=
End If o;VkoYV
End With L_gsG|xX
Next: Next: Next: Next: Next: Next )YnI !v2T
Next: Next: Next: Next: Next: Next L`\`NNQC
Loop Until True R )d99j^"
On Error GoTo 0 hdf8U
End If {"0TO|%x
If WinTag And Not ShTag Then <Sprp]n
7
MsgBox MSGONLYONE, vbInformation, HEADER F/h :&B:;
Exit Sub qsft*&
End If CFBUQMl >
On Error Resume Next (]}x[F9l
For Each w1 In Worksheets Y-%l7GErhL
'Attempt clearance with PWord1 ?b@q5Y
w1.Unprotect PWord1 X&9^&U=e
Next w1 !k:z Ljtp
On Error GoTo 0 @7Rt 4}g
ShTag = False 4h;f>BG
For Each w1 In Worksheets =MJ-s;raq
'Checks for all clear ShTag triggered to 1 if not. z^ P * :
ShTag = ShTag Or w1.ProtectContents t *Vao
Next w1 #0?"J)
If ShTag Then d(X\B{
For Each w1 In Worksheets @jE d%W
With w1 aT ?p>
If .ProtectContents Then =M1a 0i|d
On Error Resume Next >?>u bM`,
Do 'Dummy do loop C,|nmlDN
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 G>=9gSLM
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 3 ^02fy
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 qXrt0s[
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 ;z.6'EYMG
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ ;!l*7}5X=
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ L9{mYA]q
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Ei {(
If Not .ProtectContents Then `P ^u:
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ M.xhVgFf)
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ d,Cz-.'sOf
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) |TB@@ 2Ky&
MsgBox Application.Substitute(MSGPWORDFOUND2, _ @4 /~~
"$$", PWord1), vbInformation, HEADER aPD?Bh>JU
'leverage finding Pword by trying on other sheets .Bb$ j=
For Each w2 In Worksheets ZL4l
( &"
w2.Unprotect PWord1 A~6%,q@^jh
Next w2 HF & h
Exit Do 'Bypass all for...nexts U{T [*s
End If +=ZWau
Next: Next: Next: Next: Next: Next N{1.g S
Next: Next: Next: Next: Next: Next ?(5o@Xq
Loop Until True DO7- =74=
On Error GoTo 0 *F\T}k7
End If a&$Zpf!!
End With Smq r
q
Next w1 o,?!"*EP
End If t{ /:( Nu
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER =oo[ Eyr
End Sub cm@jt\D
