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

不知道要几个土币啊

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

都差不多~~~~

感谢楼主分享

做沙发下好东西看

Public Sub 工作表保护密码破解() Y=l91dxGI  
Const DBLSPACE As String = vbNewLine & vbNewLine cWSiJr):r  
Const AUTHORS As String = DBLSPACE & vbNewLine & _ ~*9 vn Z@  
"作者:XXXXXXX" & Me%ZM0  
Const HEADER As String = "工作表保护密码破解" Rw\ LVRd
A  
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1"
QXnL(z  
Const REPBACK As String = DBLSPACE & "" Re**)3#gn  
Const ZHENGLI As String = DBLSPACE & "                   XXXXXXX" oO-kO!59y  
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ -9)<[>:  
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" /ov&h;  
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" 0!YB.=\{_q  
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" .V9/0  
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" mr]IxTv  
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ (-tF=wR,W  
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" ][1*.7-  
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ <GI{`@5C  
"如果该文件工作表有不同密码,将搜索下一组密码并解除" Bkvh]k;F8  
Const MSGONLYONE As String = "确保为唯一的?" /pZ]:.A  
Dim w1 As Worksheet, w2 As Worksheet ,lLkAd?q  
Dim i As Integer, j As Integer, k As Integer, l As Integer 8r7~ >p~  
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer x'OE},>i  
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer @bQf =N+  
Dim PWord1 As String [!B($c|\  
Dim ShTag As Boolean, WinTag As Boolean pJ7M.C!  
Application.ScreenUpdating = False M/XxiF  
With ActiveWorkbook i>w'$ {  
WinTag = .ProtectStructure Or .ProtectWindows ?'_E$  
End With ^fT|Wm<  
ShTag = False a,3} o:f  
For Each w1 In Worksheets dHV3d'.P  
ShTag = ShTag Or w1.ProtectContents hiWfVz{~  
Next w1 B:om61Dn  
If Not ShTag And Not WinTag Then LwQq0<v  
MsgBox MSGNOPWORDS1, vbInformation, HEADER h0ufl.N_%  
Exit Sub 6\ g-KO  
End If 2`qO'V3Q  
MsgBox MSGTAKETIME, vbInformation, HEADER s*.CJ  
If Not WinTag Then Gj[`r  
Else )# le|Rf  
On Error Resume Next hce *G@b  
Do 'dummy do loop hm"i\JZ3N  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 b13XHR)0  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 @0cQ4}  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 E?1"&D m  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 8C1 'g7A<  
With ActiveWorkbook AvF:$kG  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ =c 3;@CO  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ ^sR]w]cz.  
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) jEwfa_Q%  
If .ProtectStructure = False And _ t{n|!T&  
.ProtectWindows = False Then x#ub % t  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ E^z\b *  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ m%Ah]x;  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) spIkXEK  
MsgBox Application.Substitute(MSGPWORDFOUND1, _ &eYnO~$!  
"$$", PWord1), vbInformation, HEADER
O(U'G|  
Exit Do 'Bypass all for...nexts =~M%zdIXv  
End If $Fx:w  
End With ?-m
Dv
W  
Next: Next: Next: Next: Next: Next vovc,4}  
Next: Next: Next: Next: Next: Next bi`{ k\3A  
Loop Until True "L'
0"  
On Error GoTo 0 UX3 ]cr  
End If 0J-]  
If WinTag And Not ShTag Then $I40 hk  
MsgBox MSGONLYONE, vbInformation, HEADER 8zv=
@`4@G  
Exit Sub }}Gz3>?24=  
End If %c[Q_  
On Error Resume Next 7#K%Bo2pG  
For Each w1 In Worksheets 0?hJ!IT;q7  
'Attempt clearance with PWord1 nX,2jT;@L  
w1.Unprotect PWord1
"iFA&$\  
Next w1 C{mL]ds<  
On Error GoTo 0 FV>j !>Y  
ShTag = False 88\0opL-  
For Each w1 In Worksheets EugQr<sM#  
'Checks for all clear ShTag triggered to 1 if not. ~^#F5w"  
ShTag = ShTag Or w1.ProtectContents NjT#p8d X  
Next w1 ts BPQ 8Ne  
If ShTag Then ~ZbEKqni2  
For Each w1 In Worksheets ;Ml??B]C  
With w1 rv>K0= t0  
If .ProtectContents Then 6q^Tq {I  
On Error Resume Next P|mV((/m4  
Do 'Dummy do loop rO8Q||@>A  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 g wM~W  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 5fpBzn$  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 xlQl1lOX  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 W\xM$#
)m  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 6")co9  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ H"hL+F^  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 6- H81y3  
If Not .ProtectContents Then V\k?$}  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ axT-  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ L@> +iZSO  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) \wW'Hk=  
MsgBox Application.Substitute(MSGPWORDFOUND2, _ tEEeek(!  
"$$", PWord1), vbInformation, HEADER ^zjQ(ca@"x  
'leverage finding Pword by trying on other sheets 0@;kD]Z  
For Each w2 In Worksheets %si5cc?  
w2.Unprotect PWord1 2w>lnJ-  
Next w2 DoV<p?U  
Exit Do 'Bypass all for...nexts rG7S^,5o  
End If xsjJ8>G  
Next: Next: Next: Next: Next: Next /9/svPc]  
Next: Next: Next: Next: Next: Next 4h:R+o ^H^  
Loop Until True 7bBOV(/s  
On Error GoTo 0
q0
Rd^c  
End If iO^z7Y7  
End With WH Z
z?|^  
Next w1 +QS7F`O  
End If 9d ZE#l!Q  
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER n7UZ&ab  
End Sub z:PH _N~