EXCEL密码破解
1\\打开文件
2\\工具---宏----录制新宏---输入名字如:aa 3\\停止录制(这样得到一个空宏)
4\\工具---宏----宏,选aa,点编辑按钮
5\\删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧)
6\\关闭编辑窗口
7\\工具---宏-----宏,选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 & _
\ \
Const HEADER As String = \ Const VERSION As String = DBLSPACE & \ersion 1.1.1 2003-Apr-04\ Const REPBACK As String = DBLSPACE & \ \
Const ALLCLEAR As String = DBLSPACE & \ \ DBLSPACE & \VE IT NOW!\ DBLSPACE & \ DBLSPACE & \ \ \
\
Const MSGNOPWORDS1 As String = \ \ Const MSGNOPWORDS2 As String = \ \ \
Const MSGTAKETIME As String = \ \ \
\
\ Const MSGPWORDFOUND1 As String = \ou had a Worksheet \ \
\ \ \
\ Const MSGPWORDFOUND2 As String = \ou had a Worksheet \ \ 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 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, _ \ 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 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, _ \ '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”（注意：如果
EXCEL密码破解
