Public Sub 工作表保护密码破解() M `bEnu
Const DBLSPACE As String = vbNewLine & vbNewLine m>@ *-*8k
Const AUTHORS As String = DBLSPACE & vbNewLine & _ (E(kw="
"作者:XXXXXXX" gsp|?) ]x
Const HEADER As String = "工作表保护密码破解" fo30f =^Gi
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" Td>Lp=0rU
Const REPBACK As String = DBLSPACE & "" y9L:2f\
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" ?Wm.'S'to
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ U.HeIJ#
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" ]za1=~[
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" @9<M W
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" 7'9~Kx&+
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" C~dD'Tq]
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ _e3kO6X
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" rwUKg[
1N
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ {`vv-[j|
"如果该文件工作表有不同密码,将搜索下一组密码并解除" ]M XeWS(
Const MSGONLYONE As String = "确保为唯一的?" -h<Rby
Dim w1 As Worksheet, w2 As Worksheet 3<nd;@:-
Dim i As Integer, j As Integer, k As Integer, l As Integer 7+vyN^XJ"5
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer LE:nmo
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer GY %48}7
Dim PWord1 As String 71ctjU`U2
Dim ShTag As Boolean, WinTag As Boolean s'/ g:aJ
Application.ScreenUpdating = False H%:~&_ D
With ActiveWorkbook n/fMq,<8
WinTag = .ProtectStructure Or .ProtectWindows w Lf=a^c#
End With LMmW3W`
ShTag = False E#=slj @
For Each w1 In Worksheets 8s_'tw/{
ShTag = ShTag Or w1.ProtectContents kK[m=rTx1$
Next w1 vpGeG
If Not ShTag And Not WinTag Then w1+xlM,,9
MsgBox MSGNOPWORDS1, vbInformation, HEADER ]"<
` ^
Exit Sub g&30 @D"
End If D20n'>ddg
MsgBox MSGTAKETIME, vbInformation, HEADER 45;{tS.z,B
If Not WinTag Then HJ2r~KIw
Else yF}l.>7D
On Error Resume Next {b^JH2,
Do 'dummy do loop /~Q2SrYH
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 A9[ELD>p
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 6R+m;'
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 p Rn vd|
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 wtDy-H n
With ActiveWorkbook 4EiEE{9V
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ E}V8+f54S
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ lxpi
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ?6gC;B
If .ProtectStructure = False And _ k%?fy
.ProtectWindows = False Then |@]`" k
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Zb)j2Xgl
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ }VlX!/42
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) uUXvBA?l
MsgBox Application.Substitute(MSGPWORDFOUND1, _ lLy^@s
"$$", PWord1), vbInformation, HEADER kK2x';21
Exit Do 'Bypass all for...nexts `<>Emc8Z
End If : [o0Va2 d
End With Gma )8X#
Next: Next: Next: Next: Next: Next Ur`Ri?
Next: Next: Next: Next: Next: Next g bOd(ugH
Loop Until True Np>[mNmga
On Error GoTo 0 ^&iUC&8W
End If &D, gKT~
If WinTag And Not ShTag Then Fj<#*2{]B
MsgBox MSGONLYONE, vbInformation, HEADER &DC
o;Ij;
Exit Sub Zi47)8
End If ngM>Tzirt
On Error Resume Next (P
{o 9
For Each w1 In Worksheets deR2l(0%yr
'Attempt clearance with PWord1 >'3J. FY
w1.Unprotect PWord1 *k:Sg*neVq
Next w1 t0XM#9L
On Error GoTo 0 *i#m5f}
ShTag = False GQXN1R
For Each w1 In Worksheets $Yh7N5XH,
'Checks for all clear ShTag triggered to 1 if not. Mq!03q6
ShTag = ShTag Or w1.ProtectContents A+d&aE }3V
Next w1 Q70LQCms
If ShTag Then G"3)\FEM
For Each w1 In Worksheets pj. }VF!d
With w1 #Jt9U1WbF
If .ProtectContents Then $
BV4 i$
On Error Resume Next Gj]*_"T
Do 'Dummy do loop j,")c'r&dD
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 #A ox$[|@
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 6]#pPk8[Z
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 #8P9}WTno.
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 c`w YQUg(
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ k
9 Xi|Yj
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ sqw^Hwy=!2
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) )8Defuxk
If Not .ProtectContents Then J%c4-'l
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ zmk# gk2H
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 0q`n] NM
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) &UtsI@Mu
MsgBox Application.Substitute(MSGPWORDFOUND2, _ ..RCR_DIp
"$$", PWord1), vbInformation, HEADER MM8r*T4g/
'leverage finding Pword by trying on other sheets 7Pu.<b}
For Each w2 In Worksheets } r:H7&|&
w2.Unprotect PWord1 ;`IZ&m $
Next w2 /*DC`,q
Exit Do 'Bypass all for...nexts [ UN`~
End If 1PLxc)LsG
Next: Next: Next: Next: Next: Next [5$=G@ zf
Next: Next: Next: Next: Next: Next d6ZJh xJ
Loop Until True ;E0Xn-o_
On Error GoTo 0 $CXKeWS=Q.
End If S<" T:Y &
End With 1DPgiIG~
Next w1 6j9P`#L t
End If ]i\C4*
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER O?|st$g
End Sub 4$D:<8B
