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

不知道要几个土币啊

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

都差不多~~~~

感谢楼主分享

做沙发下好东西看

Public Sub 工作表保护密码破解() JB.U&  
Const DBLSPACE As String = vbNewLine & vbNewLine P6'Se'f8  
Const AUTHORS As String = DBLSPACE & vbNewLine & _ pe3;pRh'  
"作者:XXXXXXX" i*!2n1c[  
Const HEADER As String = "工作表保护密码破解" t&EY$'c  
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" -g|ji.  
Const REPBACK As String = DBLSPACE & "" \.Op6ECV9  
Const ZHENGLI As String = DBLSPACE & "                   XXXXXXX" \ptjnwC^O  
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ +#<Z/  
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" SZR`uS  
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" n;>=QG -v  
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" tp&|*M3  
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" vEGI  
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ o?a3hD  
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" )%n$_N n  
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ P4/~_$e  
"如果该文件工作表有不同密码,将搜索下一组密码并解除" >&7^yXS  
Const MSGONLYONE As String = "确保为唯一的?" CHD.b%_|  
Dim w1 As Worksheet, w2 As Worksheet Qj(ppep\U"  
Dim i As Integer, j As Integer, k As Integer, l As Integer 27$,D XD  
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer E7aG&K  
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer 'ShK7j$  
Dim PWord1 As String P$*Ngt  
Dim ShTag As Boolean, WinTag As Boolean 0!$y]Gr  
Application.ScreenUpdating = False I:UDEoQo  
With ActiveWorkbook S)
4p'cUwq  
WinTag = .ProtectStructure Or .ProtectWindows &CN(PZv  
End With Y#=MN~##t  
ShTag = False hv\Dz*XTs0  
For Each w1 In Worksheets x)eoz2E1  
ShTag = ShTag Or w1.ProtectContents K1]3zLnS  
Next w1 8gt&*;'}*D  
If Not ShTag And Not WinTag Then jcBZ#|B7;  
MsgBox MSGNOPWORDS1, vbInformation, HEADER Z;RUxe|<k  
Exit Sub Nv6"c<(L=  
End If %k )H7nj  
MsgBox MSGTAKETIME, vbInformation, HEADER Z{y
H:{Vk  
If Not WinTag Then qE]e+S?57a  
Else Vry_X2  
On Error Resume Next Vi}E9I4  
Do 'dummy do loop M:iH7K  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 b`=g#B|  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 g0B%3v  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 6CW5ay_,  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 v+SdjFAY  
With ActiveWorkbook ae]6F_Qtc*  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ pv-c>8Wb6  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ <c!gg7@pm  
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) S'hUh'PZ  
If .ProtectStructure = False And _ ;ny9q  
.ProtectWindows = False Then j|!t3}((  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ ={N1j<%fh  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ #k`gm)|  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ^M;#x$Y?  
MsgBox Application.Substitute(MSGPWORDFOUND1, _ ~<s =yjTu+  
"$$", PWord1), vbInformation, HEADER oDi+\0  
Exit Do 'Bypass all for...nexts Ude?[6  
End If ',LC!^:~Nw  
End With BHZhdm@),  
Next: Next: Next: Next: Next: Next dh&>

E  
Next: Next: Next: Next: Next: Next M'|p<SO]  
Loop Until True 6DgdS5GhT_  
On Error GoTo 0 lCl5#L9  
End If PB8g4-?p6  
If WinTag And Not ShTag Then NuD|%Ebs  
MsgBox MSGONLYONE, vbInformation, HEADER Ek6g?rj_  
Exit Sub fBv: TC%  
End If 10OkrNQ  
On Error Resume Next |d*a~T0  
For Each w1 In Worksheets _:p-\Oo.  
'Attempt clearance with PWord1 N#t`ZC&m'  
w1.Unprotect PWord1 ^w<aS w  
Next w1 DrC"M*$!  
On Error GoTo 0 {P_7AM  
ShTag = False VfP\)Rl
 
For Each w1 In Worksheets gw[Eu>I  
'Checks for all clear ShTag triggered to 1 if not. !@N?0@$/  
ShTag = ShTag Or w1.ProtectContents }^p<Y5{b  
Next w1 FoH1O+e  
If ShTag Then vZ.<OD4  
For Each w1 In Worksheets =adHP|S  
With w1 cY kb3(  
If .ProtectContents Then cGdYfi  
On Error Resume Next ~a&VsC#  
Do 'Dummy do loop e"NP]_vh,  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 a_?b<  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 iemp%~UZ  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 N@}h  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 /7:+.#Ag`  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ ~dpf1fP  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ PJe_qP  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) c:>&YGmhu  
If Not .ProtectContents Then u#Jr_ze  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ hh*('n>[  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ .jk A'i@  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 2l^_OrE!  
MsgBox Application.Substitute(MSGPWORDFOUND2, _ bcpsjUiy#  
"$$", PWord1), vbInformation, HEADER ctjQBWE  
'leverage finding Pword by trying on other sheets NVsaV;u  
For Each w2 In Worksheets "d0=uHd5\  
w2.Unprotect PWord1 GdVF;  
Next w2 hwJ>IQ1  
Exit Do 'Bypass all for...nexts k,k>w#&  
End If 0.w7S6v|&  
Next: Next: Next: Next: Next: Next 9:-7.^`P  
Next: Next: Next: Next: Next: Next *L$_80  
Loop Until True zp<B,Ls  
On Error GoTo 0 ka8Y+Gs  
End If QHf&Z*Xtl  
End With 2{vAs  
Next w1 ms&1P  
End If 0< vJ*z|_  
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER #9!7-!4pW  
End Sub 0`-b57lF&