-
EXCEL VBA Project
密码破解
过程可能有些繁琐，
EXCEL
工作表保护密码破解
方法
:
1
打开文件
2
工具
---
宏
----
录制新宏
---
输入名字如
:aa
3
停止录制
(
这样得到一个空宏
)
4
工具
---
宏
----
宏<
/p>
,
选
aa,
点编
辑按钮
5
删除窗口中的所有字符
(
只有几个
),
替换为下面的内容
:(
复制吧
)
6
关闭编辑窗口
7
工具
--
-
宏
-----
宏
,
选
AllInternalPasswords,
运行
,
确定两次
,<
/p>
等
2
分钟
,
再确定
.OK,
没有
密码了
!!
内容如下：
Public Sub AllInternalPasswords()
' Breaks worksheet and
workbook structure passwords. Bob McCormick
' probably originator of
base code algorithm modified for coverage
' of workbook structure /
windows passwords and for multiple passwords
'
'
Norman Harker and JE McGimpsey 27-Dec-2002
(Version
' Modified
2003-Apr-04 by JEM: All msgs to constants, and
' eliminate one Exit Sub
(Version
' Reveals hashed
passwords NOT original passwords
Const DBLSPACE As String = vbNewLine &
vbNewLine
Const AUTHORS As
String = DBLSPACE & vbNewLine & _
Const HEADER As String =
Const VERSION As String = DBLSPACE &
Const REPBACK As String =
DBLSPACE &
Const ALLCLEAR As String = DBLSPACE &
DBLSPACE &
DBLSPACE &
DBLSPACE &
Const
MSGNOPWORDS1 As String =
Const
MSGNOPWORDS2 As String =
Const MSGTAKETIME As String =
Const
MSGPWORDFOUND1 As String =
Const
MSGPWORDFOUND2 As String =
DBLSPACE &
Const MSGONLYONE As String =
ALLCLEAR & AUTHORS & VERSION & REPBACK
Dim w1 As Worksheet, w2 As
Worksheet
Dim i As Integer,
j As Integer, k As Integer, l As Integer
Dim m As Integer, n As
Integer, i1 As Integer, i2 As Integer
Dim i3 As Integer, i4 As Integer, i5 As
Integer, i6 As Integer
Dim
PWord1 As String
Dim ShTag
As Boolean, WinTag As Boolean
= False
With ActiveWorkbook
WinTag = .ProtectStructure Or
.ProtectWindows
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or
Next w1
If Not
ShTag And Not WinTag Then
MsgBox MSGNOPWORDS1, vbInformation,
HEADER
Exit Sub
End If
MsgBox
MSGTAKETIME, vbInformation, HEADER
If Not WinTag Then
MsgBox MSGNOPWORDS2, vbInformation,
HEADER
Else
On Error Resume Next
Do 'dummy do loop
For i = 65 To 66: For j = 65 To 66: For
k = 65 To 66
For l = 65 To
66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 =
65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66:
For n = 32 To 126
With
ActiveWorkbook
.Unprotect
Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5)
& Chr(i6) & Chr(n)
If
.ProtectStructure = False And _
.ProtectWindows = False Then
PWord1 = Chr(i) & Chr(j) &
Chr(k) & Chr(l) & _
Chr(m)
& Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox (MSGPWORDFOUND1, _
Exit
Do 'Bypass all for...nexts
End If
End With
Next: Next: Next: Next:
Next: Next
Next: Next:
Next: Next: Next: Next
Loop
Until True
On Error GoTo 0
End If
If WinTag And Not ShTag Then
MsgBox MSGONLYONE,
vbInformation, HEADER
Exit
Sub
End If
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
PWord1
Next w1
On Error
GoTo 0
ShTag = False
For Each w1 In Worksheets
'Checks for all clear ShTag
triggered to 1 if not.
ShTag = ShTag Or
Next w1
If ShTag
Then
For Each w1 In
Worksheets
With w1
If .ProtectContents Then
On Error Resume Next
Do 'Dummy do loop