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 安全助手 ” 去掉，以便加快程式的執行速度。
|
|
|