EXCEL 密码破解
打开文件
工具 --- 宏 ----录制新宏 --- 输入名字如 :aa
停止录制 (这样得到一个空宏)
工具 --- 宏 ----宏 ,选 aa,点编辑按钮
删除窗口中的所有字符(只有几个 ),替换为下面的内容:(复制吧 )
关闭编辑窗口
工具 --- 宏 ----- 宏 ,选 AllInternalPasswords, 运行 ,确定两次 ,等 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 1.1)
'Modified 2003-Apr-04 by JEM: All msgs to constants, and
'eliminate one Exit Sub (Version 1.1.1)
'Reveals hashed passwords NOT original passwords
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by" & _
"Norman Harker and JE McGimpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
Const REPBACK As String = DBLSPACE & "Please report failure " & _
"to the microsoft.public.excel.programming newsgroup."
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
"now be free of all password protection, so make sure you:" & _
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
DBLSPACE & "Also, remember that the password was " & _
"put there for a reason. Don't stuff up crucial formulas " & _ "or
data." & DBLSPACE & "Access and use of some data " & _
"may be an offense. If in doubt, don't."
Const MSGNOPWORDS1 As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = "There was no protection to " & _
"workbook structure or windows." & DBLSPACE & _ "Proceeding to
unprotect sheets." & AUTHORS & VERSION
Const MSGTAKETIME As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _ "depends
on how many different passwords, the " & _
"passwords, and your computer's specification." & DBLSPACE & _
"Just be patient! Make me a coffee!" & AUTHORS & VERSION Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ "Structure or Windows Password set." & DBLSPACE & _
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ "Note it down for potential future use in other workbooks by " & _ "the same person who set this password." & DBLSPACE & _
"Now to check and clear other passwords." & AUTHORS & VERSION Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ "password set." & DBLSPACE & "The password found was: " & _ DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ "future use in other workbooks by same person who " & _
"set this password." & DBLSPACE & "Now to check and clear " & _ "other passwords." & AUTHORS & VERSION
Const MSGONL YONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ 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
Application.ScreenUpdating = False
With ActiveWorkbook
WinTag = .ProtectStructure Or .ProtectWindows
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
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 Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER
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 MSGONL YONE, vbInformation, HEADER
Exit Sub
End If
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect 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 w1.ProtectContents
Next w1
If ShTag Then
For Each w1 In Worksheets
With w1
If .ProtectContents Then
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
.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 Not .ProtectContents 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 Application.Substitute(MSGPWORDFOUND2, _
"$$", PWord1), vbInformation, HEADER
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
Exit Do 'Bypass all for...nexts
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
End With
Next w1
End If
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER End Sub
穷举破解 EXCEL 、WORD 文档密码
摘要:本文讨论了如何使用VB 编程,通过穷举法解除EXCEL 文档和WORD 文档的密码。并在破解过程
中加入了中断,以方便用户随时中断破解过程。
关键字:穷举法、解密、EXCEL 文档、 WORD 文档、密码
Excel 和 Word 提供了多种方法限制访问用户文档,以免未经授权者的查看和更改。但在信息化的今天,用
户需要记忆的密码太多,一旦密码丢失,用户将无法打开或访问该文档,给用户造成很大的损失。能否借助
计算机的高速运行,解开密码呢?通过尝试,笔者认为:在无法弄清 Excel 和 Word 加密算法的情况下,利用穷举法
尝试解密文档,是解密唯一的选择。
1. 实现原理
本程序选用VB6.0 编写,并充分利用了Office 组件中的对象库,穷举尝试各种口令,达到解密文档的目的。
⑴ 巧用整数的取整及取余,产生密码字符串
Excel 和Word 文档密码可以是字母、数字、空格以及符号的任意组合,最长可达15 个字符,且区分大小
写。
本程序的破解过程利用一个两层循环,产生选定字符的排列组合(尝试密码),其中外层循环控制密码的位
数,内层循环生成N 位密码的所有排列组合。产生尝试密码的方法是:将一个N 位字符串密码(password )作为一个“数值”,该“数值”每个位上的“数字”属于选定字符范围,且该“数值”与一个整数(X )一一对应,并
满足以下条件:0 ≤X ≤ArrayLenN -1 ( ArrayLen 是选定密码字符范围的总字符数,如:仅选定数字时,ArrayLen=10 ;仅选定数字和小写字母时,ArrayLen=10+26=36 );对X 整除、取余N-1 次,对每次的余
数 Y 做以下操作:password = password + CharArray(Y) (注:CharArray 是存放选定字符的一维数组),
最后做以下操作:password = CharArray(X MOD ArrayLen) + password ,产生的password 就是整数X 对应的 N 位字符串。
⑵利用 VB 的错误处理功能,尝试口令破解
当运行程序尝试一个密码时(用该密码打开文档),若密码错误,则会产生运行错误。为此,必须在尝试口
令前,使用On Error语句打开一个错误处理程序;由于本程序是尝试各种口令,当一个口令错误时,直接
尝试下一个口令即可,因此,应使用“On Error Resume Next ”语句。
那么,如何得知找到口令了呢?VB 有一个内部错误对象Err ,它的Number 属性中的值是用来确定发生
错误的原因。在尝试一个口令后,检查Err.Number中的值,以确定该口令是否正确。
⑶ 破解过程中的中断
利用穷举法解密对系统资源的占用是十分惊人的,在解密的过程中CPU 的利用率几乎是100% ,若不加入
解密过程中的中断,计算机系统会处于一种假死机状态。为此,在破解过程的内循环中加入了DoEvents 函数。 DoEvents函数提供了一种取消任务的简便方法,它将控制切换到操作环境内核。只要此环境中的所有
应用程序都有机会响应待处理事件,应用程序就又恢复控制。使用该函数的优点是:不会使应用程序放弃焦
点,且后台事件能够得到有效处理。
2.具体实现过程
编程实现时,需要机器安装有VB 应用程序及Microsoft Office组件。
⑴新建 VB 工程,并对其初始化
新建一个VB 工程,取名 Get_Password ,将启动窗体命名为FrmMain 。首先选择“工程”菜单中的“引用”,在“引用”对话框中选择“ Microsoft Excel10.0 Object Library和
“ Microsoft”Word10.0 Object Library(注意”:如
果安装的是Office2000或Office97,应该选择Excel 对象库和Word 对象库的 9.0 版或 8.0 版)。其次在“工
程”菜单中“部件”对话框中,选择添加“Microsoft Windows common controls-2.5(sp2) ”和“Microsoft Commo n
Dialog control 6.0,以”便在窗体设计中使用微调控件和对话框控件。
⑵在 FrmMain窗体上添加控件
在 FrmMain窗体上,按照下图的位置添加表 1 中的控件,然后根据表 1 修改每个对象的属性。
表 1:
序号控件名称控件属性及其属性值
1 Frame Name=Frame1 , Caption= 选择加密文件( *.DOC 、*.XLS )
2 Frame Name=Frame2 , Caption= 选定密码字符范围:
3 Frame Name=Frame3 , Caption= 选择密码的长度:
4 ComboBow Name=Combo1
5 CommandButton Name=CmdBrowse , Caption= 浏览
6 CommandButton Name=CmdStartCrack , Caption= 开始破解
7 CommandButton Name=CmdQuit ,Caption= 退出系统
8 CheckBox Name=ChkDigital , Caption= 数字 (10)
9 CheckBox Name=ChkLowercase , Caption= 小写字母 (26)
10 CheckBox Name=ChkUppercase , Caption= 大写字母 (26)
11 CheckBox Name=ChkSpace ,Caption= 空格 (1)
12 CheckBox Name=ChkBracket , Caption= 括号 (6)
13 CheckBox Name=ChkOthers , Caption= 其他 OEM 字符 (26)
14 TextBox Name=txtPasswordStartLong , Text=2
15 TextBox Name=txtPasswordEndLong ,Text=2
16 TextBox Name=Text1
17 UpDown Name=UpDown1 ,BuddyProperty=Text , Wrap=TRUE , Increment=1
BuddyControl=txtPasswordStartLong , Max=15 , Min=
18 UpDown Name=UpDown2 ,BuddyProperty=Text , Wrap=TRUE , Increment=1
BuddyControl=txtPasswordEndLong , Max=15 , Min=1
19 CommonDialog Name=Dialog , DialogTitle= 请选择加密的 Excel 或 Word 文档
Filter=Excel(*.xls),Word(*.doc)|*.xls;*.doc
20 Label Name=Label1 , Caption= 破解进度:
21 Label Name=Label3 , Caption= 从:
22 Label Name=Label5 , Caption= 到:
⑶ 为以上对象编写下列代码
为了便于理解,程序中增加了适当的注释。
Option Explicit
Private Sub CmdBrowse_Click()
Dialog.ShowOpen 'show the dialog
Combo1.Text = Dialog.FileName'set the Filename text box to the selected file Combo1.Refresh
End Sub
Private Sub CmdQuit_Click()
End
End Sub
Private Sub CmdStartCrack_Click()
Static blnProcessing As Boolean
Dim wd As New Word.Application, xls As New Excel.Application
Dim OpenReturn
Dim strpath, pass, StrTemp, all_char(100) As String
Dim J, K, Password_Start_Long, Password_End_Long, ArrayLen As Integer
Dim I, Temp As Long
ArrayLen = 0'数组初始化
If ChkDigital.Value = 1The n
For J = ArrayLen To ArrayLen + 9
all_char(J) = Chr(Asc("0") + J - ArrayLen) Next J
ArrayLen = ArrayLen + 10
End If
If ChkLowercase.Value = 1The n
For J = ArrayLen To ArrayLen + 25
all_char(J) = Chr(Asc("a") + J - ArrayLen) Next J
ArrayLen = ArrayLen + 26
End If
If ChkUppercase.Value = 1 Then
For J = ArrayLen To ArrayLen + 25
all_char(J) = Chr(Asc("A") + J - ArrayLen) Next J
ArrayLen = ArrayLen + 26
End If
If ChkSpace.Value = 1 Then
all_char(ArrayLen) = " "
ArrayLen = ArrayLen + 1
End If
If ChkBracket.Value = 1 Then
all_char(ArrayLen) = "("
all_char(ArrayLen+1) = ")"
all_char(ArrayLen+2) = "{"
all_char(ArrayLen+3) = "}"
all_char(ArrayLen+4) = "["
all_char(ArrayLen+5) = "]"
ArrayLen = ArrayLen + 6
End If
If ChkOthers.Value = 1 Then
For J = ArrayLen To ArrayLen + 6 '33 to 39 all_char(J) = Chr(33 + J - ArrayLen)
Next
ArrayLen = ArrayLen + 7
For J = ArrayLen To ArrayLen + 5 '42 to 47 all_char(J) = Chr(42 + J - ArrayLen)
Next J
ArrayLen = ArrayLen + 6
For J = ArrayLen To ArrayLen + 6 '58 to 64 all_char(J) = Chr(58 + J - ArrayLen)
Next J
ArrayLen = ArrayLen + 7
all_char(ArrayLen) = Chr(92)
ArrayLen = ArrayLen + 1
For J = ArrayLen To ArrayLen + 2'94 to 96
all_char(J) = Chr(94 + J - ArrayLen)
Next J
ArrayLen = ArrayLen + 3
all_char(ArrayLen) = Chr(124)
all_char(ArrayLen+1) = Chr(126)
ArrayLen = ArrayLen + 2
End If
If ArrayLen = 0 Then
MsgBox " 错误:没有选择'密码使用的字符'", , " 请选择密码使用的字符范围..."
Exit Sub
End If
If blnProcessing Then
If MsgBox(" 真的要中断解密过程吗?", vbYesNo, "用户中断任务 ") = vbYes Then blnProcessing = False
Else
CmdStartCrack.Caption = "中断破解"
blnProcessing = True
strpath = Combo1.Text
If strpath = "" Then
MsgBox " 错误:没有选择'需要解密的文件 '", , " 请选择需要解密的文件..."
Exit Sub
End If
strpath = Trim(strpath)
Password_Start_Long = Val(txtPasswordStartLong.Text)
Password_End_Long = Val(txtPasswordEndLong.Text)
If Password_Start_Long > Password_End_Long Then
Password_Start_Long = Val(txtPasswordEndLong.Text)
Password_End_Long = Val(txtPasswordStartLong.Text)
End If
Label1.Caption = "破解进度:"
Label1.Refresh
On Error Resume Next
If UCase(Right(strpath, 3)) = "XLS" Then
For K = Password_Start_Long To Password_End_Long '破解excel 开始For I = 0 To ArrayLen ^ K - 1
pass = ""
Temp = I
For J = 1 To K - 1
Temp = Temp \ ArrayLe
pass = all_char(Temp Mod ArrayLen) + pass
Next J
pass = pass + all_char(I Mod ArrayLen)
Set OpenReturn = xls.Workbooks.Open(FileName:=strpath, Password:=pass) Text1.Text = pass'显示破解进度
Text1.Refresh
If Err.Number <> 0 Then'如果解密成功 , 打开文档 ,显示密码 ,退出过程Err.Clear
Else
Label1.Caption = "文档密码:"
Text1.Text = pass
Me.Refresh
xls.Visible = True
CmdStartCrack.MousePointer = 0
CmdStartCrack.Caption = "开始破解"
blnProcessing = False
Set xls = Nothing
Exit Sub
End If
DoEvents
If Not blnProcessing Then Exit For
Next I
If Not blnProcessing Then Exit For
Next K
xls.Quit
Set xls = Nothing
Else
For K = Password_Start_Long To Password_End_Long '破解word 开始For I = 0 To ArrayLen ^ K - 1
pass = ""
Temp = I
For J = 1 To K -
Temp = Temp \ ArrayLen
pass = all_char(Temp Mod ArrayLen) + pass
Next J
pass = pass + all_char(I Mod ArrayLen)
OpenReturn = wd.Documents.Open(FileName:=strpath, passworddocument:=pass) Text1.Text = pass'显示破解进度
Text1.Refresh
If Err.Number <> 0 Then'如果解密成功,打开文档 ,显示密码 ,退出过程Err.Clear
Else
'MsgBox "word password"
Label1.Caption = "文档密码:"
Text1.Text = pass
Me.Refresh
wd.Visible = True
CmdStartCrack.MousePointer = 0
CmdStartCrack.Caption = "开始破解"
blnProcessing = False
Set wd = Nothing
Exit Sub
End If
DoEvents
If Not blnProcessing Then Exit For
Next I
If Not blnProcessing Then Exit For
Next K
wd.Quit
Set wd = Nothing
End If
CmdStartCrack.Caption = "开始破解"
If blnProcessing Then MsgBox "没有找到密码,可能是密码位数不对!", , " 提示信息 ..."
blnProcessing = False
End Sub
3. 时间复杂度分析
一个算法的时间复杂度,是指该算法的时间耗费,是该算法所求解问题规模 n 的函数。根据前面讲的实现原
理,我们知道,破解算法的时间耗费主要集中在尝试打开OFFICE 文档上,因此,当我们假设破解一个N 位字符串密码,且选定密码字符范围的总字符数为ArrayLen 时,该算法的时间复杂度是O(ArrayLen^N) 。即,当 N 确定后,该算法的时间复杂度是N 次方阶;当 ArrayLen 确定后,该算法的时间复杂度是指数阶。
都是高数量级的时间复杂度。
4. 说明
穷举法解密对系统资源的占用是十分惊人的,在解密的过程中最好不要运行其他应用程序。如果安装有瑞星等杀毒软件,应将杀毒软件的“office安全助手”去掉,以便加快程序的运行速度。
该程序在 WinXP+OfficeXP+VB6.0 环境下测试通过,笔者随便测试了一个 5 位数字密码,在 P4 机器上, 8 分钟左右即可解开口令。
表格说明(使用时删除):
1、该表格主要用途包含不局限于学校、公司企业、事业单位、政府机构,主要针对
对象为白领、学生、教师、律师、公务员、医生、工厂办公人员、单位行政人员等。
2、表格应当根据时机用途及需要进行适当的调整,该表格作为使用模板参考使用。
3、表格的行列、文字叙述、表头、表尾均应当根据实际情况进行修改。
《合同条件》是根据《中华人民共和国合同法》,对双方权利义务作出的约定,除双方协商同意对其中的某些条款作出修改、补充或取消外,都必须严格履行。
《协议条款》是按《合同条件》的顺序拟定的,主要是为《合同条件》的修改、补充提供
一个协议的格式。双方针对工实际情况,把对《合同条件》的修改、补充和对某些条款不
予采用的一致意见按《协议条款》的格式形成协议。《合同条件》和《协议条款》是双方统一意愿的体现,成为合同文件的组成部分。