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

不知道要几个土币啊

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

都差不多~~~~

感谢楼主分享

做沙发下好东西看

Public Sub 工作表保护密码破解() bt$+l[U^J  
Const DBLSPACE As String = vbNewLine & vbNewLine *-!&5~o/U  
Const AUTHORS As String = DBLSPACE & vbNewLine & _ JG2)-x;9  
"作者:XXXXXXX" 9Q!X~L|\S  
Const HEADER As String = "工作表保护密码破解" ?\HXYCi0r  
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" b&Dc DX  
Const REPBACK As String = DBLSPACE & "" 7R$]BY=  
Const ZHENGLI As String = DBLSPACE & "                   XXXXXXX" }F*u 9E  
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ .kBZ(`K  
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" ''@upZBJ  
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" F-=W7 D:[c  
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" .ZK|%VGW  
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" IT`r&;5  
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ G4jaHpPi  
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除" lS`hJ:  
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ B!Ss 35<  
"如果该文件工作表有不同密码,将搜索下一组密码并解除" :QSCky*i  
Const MSGONLYONE As String = "确保为唯一的?" BjT0mk"P  
Dim w1 As Worksheet, w2 As Worksheet R!v ?d2  
Dim i As Integer, j As Integer, k As Integer, l As Integer OV l,o  
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer -&#H@Gyw  
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer aZe[No
s  
Dim PWord1 As String s}~'o!}W  
Dim ShTag As Boolean, WinTag As Boolean yM3]<~m  
Application.ScreenUpdating = False w85PRruW  
With ActiveWorkbook Jy,Dcl  
WinTag = .ProtectStructure Or .ProtectWindows bdn{Y  
End With nly`\0C  
ShTag = False y=L9E?  
For Each w1 In Worksheets u6~|].j R  
ShTag = ShTag Or w1.ProtectContents ]"Do%
<  
Next w1 Lv;R8^n  
If Not ShTag And Not WinTag Then nUZ+N)*  
MsgBox MSGNOPWORDS1, vbInformation, HEADER ` "Gd/  
Exit Sub "TWNit  
End If V9v80e {n4  
MsgBox MSGTAKETIME, vbInformation, HEADER )8H5ovj.  
If Not WinTag Then t^|+|>S  
Else zUw9  
On Error Resume Next n9J.]+@J  
Do 'dummy do loop =xs{Ov=  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 y.zS?vv2g  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 0A~zuK  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
I|6wPV?  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 DhQYjC[  
With ActiveWorkbook K22'XrN  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ OVsZ
UmSG  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ u1?1x  
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 39W"G7n?v  
If .ProtectStructure = False And _ Ib)>M`J
 
.ProtectWindows = False Then 
"}"Bvp^  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Ha~g8R&  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _  TP6iSF  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 7p}.r J54  
MsgBox Application.Substitute(MSGPWORDFOUND1, _ k$V.hG|6M  
"$$", PWord1), vbInformation, HEADER uZyR{~-C  
Exit Do 'Bypass all for...nexts &ZjQa.-U>  
End If &{s`=IeN  
End With pg}9baW?  
Next: Next: Next: Next: Next: Next #&Zb8HAj  
Next: Next: Next: Next: Next: Next eBD7g-  
Loop Until True Y)x(+#  
On Error GoTo 0 
oQrkd:  
End If 6J|Ee1Ez  
If WinTag And Not ShTag Then T~nmEap  
MsgBox MSGONLYONE, vbInformation, HEADER =
R M=@X  
Exit Sub ZaCUc Px  
End If htn"rY(  
On Error Resume Next *):xK;o  
For Each w1 In Worksheets sA3=x7j%c  
'Attempt clearance with PWord1
x
Df<@  
w1.Unprotect PWord1 ^-CQ9r*  
Next w1 6%mFiX  
On Error GoTo 0 5WR(jl+M  
ShTag = False SX$Nef9p  
For Each w1 In Worksheets 0NY2Kw;  
'Checks for all clear ShTag triggered to 1 if not. zc<C %t[~y  
ShTag = ShTag Or w1.ProtectContents yDt3)fP#  
Next w1 Y.O/~af  
If ShTag Then WQ\H2go  
For Each w1 In Worksheets zSYh\
g"  
With w1 DR."C+  
If .ProtectContents Then ZMSP8(V  
On Error Resume Next o{EWNkmj  
Do 'Dummy do loop 0]dL;~0y.  
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 MPMa  
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 /4\!zPPj.  
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 ^&o38=70*  
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 =YPvh]][  
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ B}= WxG|)  
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ p,y(Fc~]g'  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) y<|vcg8x  
If Not .ProtectContents Then R<}Yf[TQ  
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ J?ljqA}i  
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ |%F[.9Dp  
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) *siN#
,5  
MsgBox Application.Substitute(MSGPWORDFOUND2, _ ub
|tX 'o  
"$$", PWord1), vbInformation, HEADER 09Sy- je*/  
'leverage finding Pword by trying on other sheets MZt~ Abt  
For Each w2 In Worksheets oG! S(95  
w2.Unprotect PWord1 wIW]uo/=  
Next w2 Az_s"}G  
Exit Do 'Bypass all for...nexts E(i<3U"4h[  
End If 3pSkk  
Next: Next: Next: Next: Next: Next 0@R @L}m  
Next: Next: Next: Next: Next: Next >Q0HqOq  
Loop Until True q4XS E,  
On Error GoTo 0 J%?
'Q{
  
End If C<!%VHs  
End With R@=Bk(h  
Next w1 V 0<>Xo%  
End If ^cYm.EHI  
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER 0Hz*L,Bh4  
End Sub ~E2xIhV