Public Sub 工作表保护密码破解() %5"9</a&G
Const DBLSPACE As String = vbNewLine & vbNewLine VgZsB$Ori
Const AUTHORS As String = DBLSPACE & vbNewLine & _ }E50>g
"作者:XXXXXXX" J^Wa8Q;9lX
Const HEADER As String = "工作表保护密码破解" V<T9 &8l+:
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" 9, :l8
Const REPBACK As String = DBLSPACE & "" <h: x=
Const ZHENGLI As String = DBLSPACE & " XXXXXXX" -C(crn
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ !
t? iXZ
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" ` T5W}p[6
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" :% ,:"
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" ]1#e#M]#
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" 8|l\E VV6
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ Yfzl%wc
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" L? mrba y
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ w=T\3(%j
"如果该文件工作表有不同密码,将搜索下一组密码并解除" t*1fLumXR
Const MSGONLYONE As String = "确保为唯一的?" P*3BB>FO
Dim w1 As Worksheet, w2 As Worksheet 7`DBS^O]dG
Dim i As Integer, j As Integer, k As Integer, l As Integer
CDK 5
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer $ #9;)8J
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer !xo{-@@wS
Dim PWord1 As String qKr8)}h
Dim ShTag As Boolean, WinTag As Boolean 5>D>% iaHv
Application.ScreenUpdating = False Ws|j#X<
With ActiveWorkbook GLeK'0Q@
WinTag = .ProtectStructure Or .ProtectWindows :&V h?
End With f Sa"% 8%
ShTag = False ?kbiMs1;u
For Each w1 In Worksheets *V8<:OG|e
ShTag = ShTag Or w1.ProtectContents c7x~{V8
Next w1 7o# I,d~
If Not ShTag And Not WinTag Then 4R1<nZ"e ~
MsgBox MSGNOPWORDS1, vbInformation, HEADER E/|To
Exit Sub *Doa* w Q
End If l 3ko?k
MsgBox MSGTAKETIME, vbInformation, HEADER LnH ? dy
If Not WinTag Then VJ] JjB
j
Else CYY=R'1:G{
On Error Resume Next CVL3VT1j0
Do 'dummy do loop C26>BU<
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 wsI`fO^A8
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 __G?0*3 G
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 K;?m';z0
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 &m)6J'q3k
With ActiveWorkbook L.* M&Ry
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ pZqq]mHK
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ gG(fQ
89U"
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
KY$ )#i
If .ProtectStructure = False And _ [\v}Ul
.ProtectWindows = False Then 1 28EPK
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ s %j_H
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ i: Y^{\Z?V
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ux vqMgR
MsgBox Application.Substitute(MSGPWORDFOUND1, _ +M\`#i\g>
"$$", PWord1), vbInformation, HEADER ~j}cyHg
Exit Do 'Bypass all for...nexts q_A!'sm@)
End If 5m&9"T. w
End With Vt :~q{9*k
Next: Next: Next: Next: Next: Next `ZyI!"
Next: Next: Next: Next: Next: Next :V RNs
Loop Until True /
F4z g3
On Error GoTo 0 4.[^\N
End If N"Zt47(
If WinTag And Not ShTag Then ,St#Vla
MsgBox MSGONLYONE, vbInformation, HEADER $P^q!H4D
Exit Sub 3Q.#c,`jV
End If #S!)JM|4wk
On Error Resume Next PNgY >=Y
For Each w1 In Worksheets
'7hu 2i5
'Attempt clearance with PWord1 rWa2pO
w1.Unprotect PWord1 n|9-KTe7|*
Next w1 !Qu"BF
On Error GoTo 0 :L F?
ShTag = False 9PXFRxGA
For Each w1 In Worksheets D9^h;
8
'Checks for all clear ShTag triggered to 1 if not. -#u=\8
ShTag = ShTag Or w1.ProtectContents n|Q@UPb/=
Next w1 1 ySk;;3
If ShTag Then Ez c?#<+7
For Each w1 In Worksheets ' YmIKIw
With w1 e>+i>/Fn{h
If .ProtectContents Then L*xhGoC=
On Error Resume Next 3no%E03p
Do 'Dummy do loop ?PeJlpYzV
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 `T@i. 'X
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 s >7}zU]
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 RzE_K' M
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
mHdA2
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 4xjP iHd<
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ i&bA2p3+d
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) h-q3U%R4}@
If Not .ProtectContents Then G|!Tj X7s
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ iT3BF"ZqBO
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ |"ls\ 7
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) /R]U}o^/(%
MsgBox Application.Substitute(MSGPWORDFOUND2, _ }YGV\Nu
"$$", PWord1), vbInformation, HEADER C kOz
'leverage finding Pword by trying on other sheets qkDI] (4
For Each w2 In Worksheets c|e~BQdRw
w2.Unprotect PWord1 ^c"jH'#.L
Next w2 [%y';`( x
Exit Do 'Bypass all for...nexts '3 /4?wi
End If 6 F!+T=
Next: Next: Next: Next: Next: Next bzBEX mC
Next: Next: Next: Next: Next: Next t5\-v_mG=&
Loop Until True y\4L{GlBM
On Error GoTo 0 Cjm`|~&e+
End If )~)J?l3 {
End With IA8f*]?
Next w1 * 2p t%eav
End If LDgrR[
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER Gp ?a(-K5
End Sub naG=Pq <
