反倾边坡其稳定性分析 [复制链接]

不知道要几个土币啊

不知道是哪位大师的高论？

都差不多~~~~

感谢楼主分享

做沙发下好东西看

Public Sub 工作表保护密码破解() FcyFE~>2  
Const DBLSPACE As String = vbNewLine & vbNewLine `> +
:38  
Const AUTHORS As String = DBLSPACE & vbNewLine & _ X$_pDF&\z  
"作者:XXXXXXX" NdrR+t^#  
Const HEADER As String = "工作表保护密码破解" @U9`V&])F[  
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" H3( @Q^9  
Const REPBACK As String = DBLSPACE & "" ,P=.x%  
Const ZHENGLI As String = DBLSPACE & "                   XXXXXXX" OxUc,%e9P  
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ L nyow}  
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" T[MDjhv'  
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" plpb4> S  
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" I=
a?z<  
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" aLlHR_  
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ |Qn>K   
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" w:x[kA  
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ 4gZ)9ya  
"如果该文件工作表有不同密码,将搜索下一组密码并解除" N1"p ;czK  
Const MSGONLYONE As String = "确保为唯一的?" vOv"^X  
Dim w1 As Worksheet, w2 As Worksheet KyBtt47\  
Dim i As Integer, j As Integer, k As Integer, l As Integer <k{_YRB  
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer PsOq-  
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer KNR7Igw?}  
Dim PWord1 As String M*D@zb0ia  
Dim ShTag As Boolean, WinTag As Boolean UhJ!7Ws$  
Application.ScreenUpdating = False 1 hD(l6tG@  
With ActiveWorkbook Ctx>#uN6  
WinTag = .ProtectStructure Or .ProtectWindows z m]R76  
End With .o]9 HbIk5  
ShTag = False ]dgi]R|`  
For Each w1 In Worksheets ~y"OyOi&  
ShTag = ShTag Or w1.ProtectContents `G%h=rr^c  
Next w1 1DGl[k/zv  
If Not ShTag And Not WinTag Then *$Zy|&[Z  
MsgBox MSGNOPWORDS1, vbInformation, HEADER ct<X
KqbI  
Exit Sub rV} 5&N*c  
End If i)$ySlEh  
MsgBox MSGTAKETIME, vbInformation, HEADER Wevd6)\  
If Not WinTag Then BqUwvB4  
Else `?SC.KT  
On Error Resume Next A4Q{(z-?  
Do 'dummy do loop {ft |*  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 K(HrwH`a{  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 xzOn[.Fi  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 ,<Wt8'e  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 g:@4/+TSt  
With ActiveWorkbook ^E.mG>
 
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ A[F_x*S  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ \S&OAe/b  
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) $wDSED -  
If .ProtectStructure = False And _ yYSoJqj Q  
.ProtectWindows = False Then DQ9aq.;  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ mA"[x_  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ bZ^'_OOn  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) G(BSe`f  
MsgBox Application.Substitute(MSGPWORDFOUND1, _ a
 <Iikx  
"$$", PWord1), vbInformation, HEADER /1$u|Gs *  
Exit Do 'Bypass all for...nexts <PM.4B@  
End If oTx>oM,  
End With q=-h#IF^  
Next: Next: Next: Next: Next: Next IZ87Px>zL  
Next: Next: Next: Next: Next: Next xM@s`s|n  
Loop Until True Y0J:c?,  
On Error GoTo 0 V]m}xZ'?^  
End If DLD9  
If WinTag And Not ShTag Then rhZp  
MsgBox MSGONLYONE, vbInformation, HEADER >[:qJ|i%  
Exit Sub H!Dj.]T  
End If Onou:kmf1  
On Error Resume Next J8ScKMUN2  
For Each w1 In Worksheets %oWG"u  
'Attempt clearance with PWord1 Ro4!y:2|  
w1.Unprotect PWord1 MZxU)QW1
  
Next w1 |WSpWsr,  
On Error GoTo 0 pred{HEye  
ShTag = False ydj*Jy'  
For Each w1 In Worksheets .}T-R?  
'Checks for all clear ShTag triggered to 1 if not. H9(UzyN>i  
ShTag = ShTag Or w1.ProtectContents ?%#no{9  
Next w1 0C\cM92o  
If ShTag Then 2#
#mVEo.(  
For Each w1 In Worksheets BOP7@D  
With w1 YB!f=_8  
If .ProtectContents Then s^4wn:*$zd  
On Error Resume Next
.J8 gW  
Do 'Dummy do loop }RKsS3}   
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 uy~$ :0o  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 .m
cohfR  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 Ne
P  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 J<4_<.o(a  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ (`4&Y-  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ S)W?W}*R\  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) wy{
sS}  
If Not .ProtectContents Then /3VO!V]u  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 2|] <U[  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 7=Pj}x)  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) %d40us8E  
MsgBox Application.Substitute(MSGPWORDFOUND2, _ />pAZa  
"$$", PWord1), vbInformation, HEADER NU+PG`Vb  
'leverage finding Pword by trying on other sheets y>#kT  
For Each w2 In Worksheets dLeos9M:  
w2.Unprotect PWord1 c5:0`~5Fn  
Next w2 5wha _Yet  
Exit Do 'Bypass all for...nexts 9a_UxF+6/  
End If /m,i,NX07  
Next: Next: Next: Next: Next: Next
+$xw0)|  
Next: Next: Next: Next: Next: Next ?L H[,8z  
Loop Until True Fy!s$!\C0  
On Error GoTo 0 bg_io*K  
End If 3gD <!WI  
End With V~Z)
^.6  
Next w1 cIC/3g}]  
End If mAY/J0_  
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER QMmZvz\^  
End Sub [*I7^h%