Public Sub 工作表保护密码破解() ]_hrYjX;
Const DBLSPACE As String = vbNewLine & vbNewLine |}FK;@'I 6
Const AUTHORS As String = DBLSPACE & vbNewLine & _ CnXl 7"
"作者:XXXXXXX" , GU|3
Const HEADER As String = "工作表保护密码破解" MF41q%9p
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" 3iKy>
Const REPBACK As String = DBLSPACE & "" TJ5g? #Wul
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" =V[ey
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ #A:+|{H"
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" dF`\ewRFn
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"
=JR6-A1>
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" #s}c K
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" -|FSdzvg
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ }|Ao@UvH
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" N Dqvt$
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ ~ {xm(p
"如果该文件工作表有不同密码,将搜索下一组密码并解除" W ZAkp|R
Const MSGONLYONE As String = "确保为唯一的?" #+Pk_?
Dim w1 As Worksheet, w2 As Worksheet ]zt77'J
Dim i As Integer, j As Integer, k As Integer, l As Integer xh90 q m
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer "R!) "B ==
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer P@xb
Dim PWord1 As String C||9 u}Q<
Dim ShTag As Boolean, WinTag As Boolean !Z}d^$
Application.ScreenUpdating = False rD?G7l<~>_
With ActiveWorkbook 01_*^iCf5
WinTag = .ProtectStructure Or .ProtectWindows 2X)n.%4g$;
End With J?1U'/Wx2
ShTag = False )*CDufRFz
For Each w1 In Worksheets j} .,|7X
ShTag = ShTag Or w1.ProtectContents nRS iW*;R
Next w1 V9 J`LQ\0
If Not ShTag And Not WinTag Then W[R^5{ k`
MsgBox MSGNOPWORDS1, vbInformation, HEADER 6 o!*bWh
Exit Sub [ e6zCN^t
End If GI
;
MsgBox MSGTAKETIME, vbInformation, HEADER ->rr4xaK C
If Not WinTag Then fK?/o]vq
Else zF([{5r[!)
On Error Resume Next Y48MCL
Do 'dummy do loop P2t{il
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 8=T[Y`;x
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 s{:l yp
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 ~B2,edkM
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 1OOMqFn} L
With ActiveWorkbook Fs} vI~}
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ A7c* qBt
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ hUo}n>Aa
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) dW4FMm >|
If .ProtectStructure = False And _ @}oY6cW;B*
.ProtectWindows = False Then kHhxR;ymA7
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ a:V2(nY
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ uA]!y{"}J
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) P
=jRof$
MsgBox Application.Substitute(MSGPWORDFOUND1, _ jY|fP!?[
"$$", PWord1), vbInformation, HEADER ` v"p""_H
Exit Do 'Bypass all for...nexts &9ZrZ"]
End If -
fx?@
End With QrSF1y'd
Next: Next: Next: Next: Next: Next 6dlV:f_\y
Next: Next: Next: Next: Next: Next :g~X"C1s
Loop Until True W)z@>4`Bb
On Error GoTo 0 ;+3XDz
v
End If nPRv.h
If WinTag And Not ShTag Then +f"q^R IU
MsgBox MSGONLYONE, vbInformation, HEADER Q?xCb
Exit Sub ,"xr^@W
End If D9
\!9 7
On Error Resume Next OC5\3H
For Each w1 In Worksheets Tfow_t}\
'Attempt clearance with PWord1 =Y ]'wb
w1.Unprotect PWord1 Iss)7I
Next w1 D~T;z pS
On Error GoTo 0 9,J^tN@ ^
ShTag = False u ozK'L
For Each w1 In Worksheets A1p87o>
'Checks for all clear ShTag triggered to 1 if not. |]UR& *
ShTag = ShTag Or w1.ProtectContents G}V5PEF]`
Next w1 !+ H)N
If ShTag Then 5==hyIy
For Each w1 In Worksheets ?qt .+2:
With w1 Bid+,,
If .ProtectContents Then 7]F@ g}8
On Error Resume Next QJ^'Uyfdn
Do 'Dummy do loop !l|fzS8g
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 /BQB 7vL
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 ]*v [6 +
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 4m"6$
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 W20 H4!G
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ ;_iDiL C;
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ I ]H P
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
HE{Ji Af
If Not .ProtectContents Then I(Gl8F\c~
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ ; nc3O{rU
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ (,XbxDfM
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) g/(3D
MsgBox Application.Substitute(MSGPWORDFOUND2, _ (kmrWx=
$
"$$", PWord1), vbInformation, HEADER TJ_pMU
'leverage finding Pword by trying on other sheets FnWN]9
For Each w2 In Worksheets G<W;HM j2
w2.Unprotect PWord1 cUj^aT pm
Next w2 &\m=|S
Exit Do 'Bypass all for...nexts 59#o+qo4
End If iPCDxDLN3V
Next: Next: Next: Next: Next: Next a \ZNN k
Next: Next: Next: Next: Next: Next E@/* eJ
Loop Until True 4'# ?"I
On Error GoTo 0 t->I# t7
End If P<C=9@`!
End With qtlcY 8!
Next w1 z]HaE|j}S
End If wO&+ Bb\=
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER A/sM
?!p>_
End Sub %Xe 74C"
