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

不知道要几个土币啊

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

都差不多~~~~

感谢楼主分享

做沙发下好东西看

Public Sub 工作表保护密码破解() 5u\#@% \6  
Const DBLSPACE As String = vbNewLine & vbNewLine t0^chlJP$  
Const AUTHORS As String = DBLSPACE & vbNewLine & _ cV=0)'&<`_  
"作者:XXXXXXX" HF(pC7/a:  
Const HEADER As String = "工作表保护密码破解" Ancka  
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" J.nJ@?O+  
Const REPBACK As String = DBLSPACE & "" %9bf^LyD  
Const ZHENGLI As String = DBLSPACE & "                   XXXXXXX" *{_WM}G  
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ --t"X<.z  
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" -&L(0?*qo  
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" ccUI\!TD{/  
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" 7w}PYp1Z'~  
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" $K_G|Wyi  
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ XTzz/.T;Z  
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" 0A]+9@W;  
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ ^0 zWiX  
"如果该文件工作表有不同密码,将搜索下一组密码并解除" =6PTT$,
 
Const MSGONLYONE As String = "确保为唯一的?" BKd03s=  
Dim w1 As Worksheet, w2 As Worksheet _J|cJ %F>%  
Dim i As Integer, j As Integer, k As Integer, l As Integer X\\c=[#8-  
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer {KH
!PAh  
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer 0keqtr  
Dim PWord1 As String PubO|Mf  
Dim ShTag As Boolean, WinTag As Boolean Z/Vb_  
Application.ScreenUpdating = False nSMw5  
With ActiveWorkbook Me*woCos'  
WinTag = .ProtectStructure Or .ProtectWindows fdU`+[_  
End With oP[R?zN  
ShTag = False y7iHB k"^:  
For Each w1 In Worksheets <xb=.xe  
ShTag = ShTag Or w1.ProtectContents Zo
=w8Hr  
Next w1 !CJh6X!  
If Not ShTag And Not WinTag Then O,$ ?Pj6  
MsgBox MSGNOPWORDS1, vbInformation, HEADER <=1nr@L  
Exit Sub bl/tl_.p00  
End If H1!u1k1nl  
MsgBox MSGTAKETIME, vbInformation, HEADER }f/xMp-Y  
If Not WinTag Then rn$LZE %  
Else FLWQY,  
On Error Resume Next -0pAj}_2}  
Do 'dummy do loop ],!7S"{97  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 MST\_s%[  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 w;e42.\  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 mpsi{%gA  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 e}F1ZJz  
With ActiveWorkbook =f{)!uW<4  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ OrN~ Y#D  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ vKX6@eg"  
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) `$kKTc:f  
If .ProtectStructure = False And _ VLLE0W _]  
.ProtectWindows = False Then @51!vQwqR  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ uA`EJ )d  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ #Cj$;q{!  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) G54,`uz2  
MsgBox Application.Substitute(MSGPWORDFOUND1, _ G@Jl4iHug"  
"$$", PWord1), vbInformation, HEADER n@`D:;?{  
Exit Do 'Bypass all for...nexts [I XX#^F  
End If J5i$D
0K[  
End With K<BS%~,I  
Next: Next: Next: Next: Next: Next C rA7lu'  
Next: Next: Next: Next: Next: Next orT%lHwjL  
Loop Until True w+^z{3>  
On Error GoTo 0 wD*z >v$  
End If WUEjWJA-MB  
If WinTag And Not ShTag Then !(%^Tg=  
MsgBox MSGONLYONE, vbInformation, HEADER ;v}f7v '  
Exit Sub nnw5 !q_  
End If G<dWh.|`=  
On Error Resume Next U};~ff+  
For Each w1 In Worksheets \{g;|Z1  
'Attempt clearance with PWord1 "Uk "  
w1.Unprotect PWord1 28u3B2\$  
Next w1 )/32sz]~  
On Error GoTo 0 71g\fGG\  
ShTag = False @<n8?"{5S  
For Each w1 In Worksheets -#TF&-  
'Checks for all clear ShTag triggered to 1 if not. *hm;C+<~  
ShTag = ShTag Or w1.ProtectContents at N%csA0  
Next w1 .>/Tc  
If ShTag Then kNqIPvuMr  
For Each w1 In Worksheets g8+Ke'=_  
With w1 MLd*WpiI.  
If .ProtectContents Then ceKR?%8s  
On Error Resume Next am+'j5`Ys  
Do 'Dummy do loop APne!  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66  Sj,>O:p  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 D@-'<0=  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 HU~,_m  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 ,McwPHEMB  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ ap 5D6y+  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ VG)Y$S8.>  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) .}xF2'~E/  
If Not .ProtectContents Then 8w 2$H  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ EWU(Al T  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 3#d?  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) cx+li4v  
MsgBox Application.Substitute(MSGPWORDFOUND2, _ &Fw8V=Pw  
"$$", PWord1), vbInformation, HEADER XIS.0]~  
'leverage finding Pword by trying on other sheets [ X7LV  
For Each w2 In Worksheets Or({|S9d2  
w2.Unprotect PWord1 +{eZ@  
Next w2 {? a@UUvC  
Exit Do 'Bypass all for...nexts mN!5JZ'2  
End If l(o;O.dLt  
Next: Next: Next: Next: Next: Next =1:dKo8  
Next: Next: Next: Next: Next: Next W*S!}ZT`  
Loop Until True I;=HXL  
On Error GoTo 0 4>JDo,AWy  
End If f:w#r.]
 
End With D&)w =qIu  
Next w1  !623;  
End If
a>_Cxsb&`  
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER hny(:Dj  
End Sub =|Q7k+b