1.打開文件
2.工具 --- 宏 ---- 錄制新宏 --- 輸入名字如 :aa
3.停止錄制 ( 這樣得到一個空宏 )
4.工具 --- 宏 ---- 宏 , 選 aa, 點編輯按鈕
5.刪除窗口中的所有字符 ( 只有幾個 ), 替換為下面的內容 :( 復制吧 )
6.關閉編輯窗口
7.工具 --- 宏 ----- 宏 , 選 AllInternalPasswords,
8.運行 , 確定兩次 , 等 2 分鍾 , 然后再確定 ，瞬間沒有密碼了
內容如下：
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 MSGONLYONE 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 w 1 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 MSGONLYONE, vbInformation, HEADER
Exit Sub
End If
On Error Resume Next
For Each w 1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
Next w1
On Error GoTo 0
ShTag = False
For Each w 1 In Worksheets
'Checks for all clear ShTag triggered to 1 if not.
ShTag = ShTag Or w1.ProtectContents
Next w1
If ShTag Then
For Each w 1 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 w 2 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 Common 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 = 1 The 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 = 1 The 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 安全助手 ” 去掉，以便加快程序的運行速度。 |
| |
