EXCEL密碼破解無(wú)需任何工具插件超簡(jiǎn)單

1、實(shí)用標(biāo)準(zhǔn)文案此方法無(wú)需任何工具只需要按照以下步驟操作就可以破解EXCEL密碼，方便簡(jiǎn)單快捷EXCEL密碼破解1打開(kāi)文件2工具-宏-錄制新宏-輸入名字如:aa3停止錄制(這樣得到一個(gè)空宏)4工具-宏-宏,選aa,點(diǎn)編輯按鈕5刪除窗口中的所有字符(只有幾個(gè)),替換為下面的內(nèi)容:(復(fù)制吧)6關(guān)閉編輯窗口7工具-宏-宏,選AllInternalPasswords,運(yùn)行,確定兩次,等2分鐘,再確定.OK,沒(méi)有密碼了!內(nèi)容如下：Public Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords.

2、 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 ' el

3、iminate 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&

4、quot; 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 gramming newsgroup.&q

5、uot; 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!, BACKU

6、P!" & _ 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,

7、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."

8、& 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 differen

9、t 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 Passwor

10、d 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 c

11、heck 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

12、 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 structu

13、re / 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 Int

14、eger 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.P

15、rotectContents 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 6

16、6: 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) & Ch

17、r(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) &am

18、p; 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 M

19、SGONLYONE, 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.ProtectCon

20、tents 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

21、= 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

22、(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.Unpro

23、tect 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文檔密碼

24、摘要：本文討論了如何使用VB編程，通過(guò)窮舉法解除EXCEL文檔和WORD文檔的密碼。并在破解過(guò)程中加入了中斷，以方便用戶隨時(shí)中斷破解過(guò)程。關(guān)鍵字：窮舉法、解密、EXCEL文檔、WORD文檔、密碼Excel和Word提供了多種方法限制訪問(wèn)用戶文檔，以免未經(jīng)授權(quán)者的查看和更改。但在信息化的今天，用戶需要記憶的密碼太多，一旦密碼丟失，用戶將無(wú)法打開(kāi)或訪問(wèn)該文檔，給用戶造成很大的損失。能否借助計(jì)算機(jī)的高速運(yùn)行，解開(kāi)密碼呢？通過(guò)嘗試，筆者認(rèn)為：在無(wú)法弄清Excel和Word加密算法的情況下，利用窮舉法嘗試解密文檔，是解密唯一的選擇。1. 實(shí)現(xiàn)原理本程序選用VB6.0編寫(xiě)，并充分利用了Office組件中的

25、對(duì)象庫(kù)，窮舉嘗試各種口令，達(dá)到解密文檔的目的。 巧用整數(shù)的取整及取余，產(chǎn)生密碼字符串Excel和Word文檔密碼可以是字母、數(shù)字、空格以及符號(hào)的任意組合，最長(zhǎng)可達(dá) 15 個(gè)字符，且區(qū)分大小寫(xiě)。本程序的破解過(guò)程利用一個(gè)兩層循環(huán)，產(chǎn)生選定字符的排列組合（嘗試密碼），其中外層循環(huán)控制密碼的位數(shù)，內(nèi)層循環(huán)生成N位密碼的所有排列組合。產(chǎn)生嘗試密碼的方法是：將一個(gè)N位字符串密碼（password）作為一個(gè)“數(shù)值”，該“數(shù)值”每個(gè)位上的“數(shù)字”屬于選定字符范圍，且該“數(shù)值”與一個(gè)整數(shù)（X）一一對(duì)應(yīng)，并滿足以下條件： 0 X ArrayLenN-1（ArrayLen是選定密碼字符范圍的總字符數(shù)，如：僅選定數(shù)字

26、時(shí)，ArrayLen=10；僅選定數(shù)字和小寫(xiě)字母時(shí)，ArrayLen=10+26=36）；對(duì)X整除、取余N-1次，對(duì)每次的余數(shù)Y做以下操作：password = password + CharArray(Y) （注：CharArray是存放選定字符的一維數(shù)組），最后做以下操作：password = CharArray(X MOD ArrayLen) + password，產(chǎn)生的password 就是整數(shù)X對(duì)應(yīng)的N位字符串。 利用VB的錯(cuò)誤處理功能，嘗試口令破解當(dāng)運(yùn)行程序嘗試一個(gè)密碼時(shí)（用該密碼打開(kāi)文檔），若密碼錯(cuò)誤，則會(huì)產(chǎn)生運(yùn)行錯(cuò)誤。為此，必須在嘗試口令前，使用On Error 語(yǔ)句打開(kāi)一個(gè)錯(cuò)

27、誤處理程序；由于本程序是嘗試各種口令，當(dāng)一個(gè)口令錯(cuò)誤時(shí)，直接嘗試下一個(gè)口令即可，因此，應(yīng)使用 “On Error Resume Next”語(yǔ)句。那么，如何得知找到口令了呢？ VB有一個(gè)內(nèi)部錯(cuò)誤對(duì)象Err，它的 Number 屬性中的值是用來(lái)確定發(fā)生錯(cuò)誤的原因。在嘗試一個(gè)口令后，檢查Err.Number中的值，以確定該口令是否正確。 破解過(guò)程中的中斷利用窮舉法解密對(duì)系統(tǒng)資源的占用是十分驚人的，在解密的過(guò)程中CPU的利用率幾乎是100%，若不加入解密過(guò)程中的中斷，計(jì)算機(jī)系統(tǒng)會(huì)處于一種假死機(jī)狀態(tài)。為此，在破解過(guò)程的內(nèi)循環(huán)中加入了DoEvents函數(shù)。DoEvents函數(shù)提供了一種取消任務(wù)的簡(jiǎn)便方法，

28、它將控制切換到操作環(huán)境內(nèi)核。只要此環(huán)境中的所有應(yīng)用程序都有機(jī)會(huì)響應(yīng)待處理事件，應(yīng)用程序就又恢復(fù)控制。使用該函數(shù)的優(yōu)點(diǎn)是：不會(huì)使應(yīng)用程序放棄焦點(diǎn)，且后臺(tái)事件能夠得到有效處理。2. 具體實(shí)現(xiàn)過(guò)程 編程實(shí)現(xiàn)時(shí)，需要機(jī)器安裝有VB應(yīng)用程序及Microsoft Office組件。 新建VB工程，并對(duì)其初始化新建一個(gè)VB工程，取名Get_Password，將啟動(dòng)窗體命名為FrmMain。首先選擇“工程”菜單中的“引用”，在“引用”對(duì)話框中選擇“Microsoft Excel10.0 Object Library”和“Microsoft Word10.0 Object Library”（注意：如果安裝的是O

29、ffice2000或Office97，應(yīng)該選擇Excel對(duì)象庫(kù)和Word對(duì)象庫(kù)的9.0版或8.0版）。其次在“工程”菜單中“部件”對(duì)話框中，選擇添加“Microsoft Windows common controls -2.5(sp2)”和“Microsoft Common Dialog control 6.0”，以便在窗體設(shè)計(jì)中使用微調(diào)控件和對(duì)話框控件。 在FrmMain窗體上添加控件在FrmMain窗體上，按照下圖的位置添加表1中的控件，然后根據(jù)表1修改每個(gè)對(duì)象的屬性。 表1：序號(hào)      控件名稱  

30、60;   控件屬性及其屬性值1      Frame      Name=Frame1，Caption=選擇加密文件（*.DOC、*.XLS）2      Frame      Name=Frame2，Caption=選定密碼字符范圍：3      Frame      Nam

31、e=Frame3，Caption=選擇密碼的長(zhǎng)度：4      ComboBow      Name=Combo15      CommandButton      Name=CmdBrowse，Caption=瀏覽6      CommandButton      Name=CmdStartCra

32、ck，Caption=開(kāi)始破解7      CommandButton      Name=CmdQuit，Caption=退出系統(tǒng)8      CheckBox      Name=ChkDigital，Caption=數(shù)字(10)9      CheckBox      Name=ChkLowe

33、rcase，Caption=小寫(xiě)字母(26)10      CheckBox      Name=ChkUppercase，Caption=大寫(xiě)字母(26)11      CheckBox      Name=ChkSpace，Caption=空格(1)12      CheckBox      N

34、ame=ChkBracket，Caption=括號(hào)(6)13      CheckBox      Name=ChkOthers，Caption=其他OEM字符(26)14      TextBox      Name=txtPasswordStartLong， Text=215      TextBox   

35、0;  Name=txtPasswordEndLong，Text=216      TextBox      Name=Text117      UpDown      Name=UpDown1，BuddyProperty=Text，Wrap=TRUE，Increment=1         

36、60; BuddyControl=txtPasswordStartLong，Max=15，Min=18      UpDown      Name=UpDown2，BuddyProperty=Text，Wrap=TRUE，Increment=1           BuddyControl=txtPasswordEndLong，Max=15，Min=119   

37、60;  CommonDialog      Name=Dialog，DialogTitle=請(qǐng)選擇加密的Excel或Word文檔           Filter=Excel(*.xls)，Word(*.doc)|*.xls;*.doc20      Label      Name=Label1， Caption=破解進(jìn)度：21

38、0;     Label      Name=Label3，Caption=從：22      Label      Name=Label5，Caption=到： 為以上對(duì)象編寫(xiě)下列代碼為了便于理解，程序中增加了適當(dāng)?shù)淖⑨尅ption ExplicitPrivate Sub CmdBrowse_Click()    Dialog.ShowOpen 'show the

39、dialog    Combo1.Text = Dialog.FileName   'set the Filename text box to the selected file    Combo1.RefreshEnd SubPrivate Sub CmdQuit_Click()    EndEnd SubPrivate Sub CmdStartCrack_Click()    Static blnProcessing As Boolean

40、60;   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

41、 Long    ArrayLen = 0    '數(shù)組初始化    If ChkDigital.Value = 1 Then        For J = ArrayLen To ArrayLen + 9            all_char(J) = Chr(Asc("0") + J - Arr

42、ayLen)        Next J        ArrayLen = ArrayLen + 10    End If    If ChkLowercase.Value = 1 Then        For J = ArrayLen To ArrayLen + 25    

43、0;       all_char(J) = Chr(Asc("a") + J - ArrayLen)        Next J        ArrayLen = ArrayLen + 26    End If    If ChkUppercase.Value = 1 Then   &

44、#160;    For J = ArrayLen To ArrayLen + 25            all_char(J) = Chr(Asc("A") + J - ArrayLen)        Next J        ArrayLen = ArrayLen + 26 &#

45、160;  End If    If ChkSpace.Value = 1 Then        all_char(ArrayLen) = " "        ArrayLen = ArrayLen + 1    End If    If ChkBracket.Value = 1 Then    

46、;    all_char(ArrayLen) = "("        all_char(ArrayLen+1) = ")"        all_char(ArrayLen+2) = ""        all_char(ArrayLen+3) = ""  

47、;      all_char(ArrayLen+4) = ""        all_char(ArrayLen+5) = ""        ArrayLen = ArrayLen + 6    End If    If ChkOthers.Value = 1 Then   

48、     For J = ArrayLen To ArrayLen + 6    '33 to 39            all_char(J) = Chr(33 + J - ArrayLen)        Next       ArrayLen = ArrayLen + 7 

49、       For J = ArrayLen To ArrayLen + 5    '42 to 47            all_char(J) = Chr(42 + J - ArrayLen)        Next J        Arra

50、yLen = ArrayLen + 6        For J = ArrayLen To ArrayLen + 6    '58 to 64            all_char(J) = Chr(58 + J - ArrayLen)        Next J   

51、0;    ArrayLen = ArrayLen + 7        all_char(ArrayLen) = Chr(92)        ArrayLen = ArrayLen + 1        For J = ArrayLen To ArrayLen + 2    '94 to 96  

52、          all_char(J) = Chr(94 + J - ArrayLen)        Next J        ArrayLen = ArrayLen + 3        all_char(ArrayLen) = Chr(124)   

53、0;    all_char(ArrayLen+1) = Chr(126)        ArrayLen = ArrayLen + 2    End If    If ArrayLen = 0 Then        MsgBox "錯(cuò)誤：沒(méi)有選擇'密碼使用的字符'", , "請(qǐng)選擇密碼使用的字符范圍."

54、60;       Exit Sub    End If    If blnProcessing Then        If MsgBox("真的要中斷解密過(guò)程嗎？", vbYesNo, "用戶中斷任務(wù)") = vbYes Then blnProcessing = False    Else    

55、;    CmdStartCrack.Caption = "中斷破解"        blnProcessing = True        strpath = Combo1.Text        If strpath = "" Then      

56、0;     MsgBox "錯(cuò)誤：沒(méi)有選擇'需要解密的文件'", , "請(qǐng)選擇需要解密的文件."            Exit Sub        End If        strpath = Trim(strpath)  &

57、#160;     Password_Start_Long = Val(txtPasswordStartLong.Text)        Password_End_Long = Val(txtPasswordEndLong.Text)        If Password_Start_Long > Password_End_Long Then     

58、0;      Password_Start_Long = Val(txtPasswordEndLong.Text)            Password_End_Long = Val(txtPasswordStartLong.Text)        End If        Label1.C

59、aption = "破解進(jìn)度："        Label1.Refresh        On Error Resume Next        If UCase(Right(strpath, 3) = "XLS" Then          &#

60、160; For K = Password_Start_Long To Password_End_Long    '破解excel開(kāi)始                For I = 0 To ArrayLen K - 1                

61、    pass = ""                    Temp = I                    For J = 1 To K - 1 

62、                       Temp = Temp ArrayLe                        pass = al

63、l_char(Temp Mod ArrayLen) + pass                    Next J                    pass = pass + all_char(I Mod Arr

64、ayLen)                    Set OpenReturn = xls.Workbooks.Open(FileName:=strpath, Password:=pass)                  &

65、#160; Text1.Text = pass    '顯示破解進(jìn)度                    Text1.Refresh                    If E

66、rr.Number <> 0 Then  '如果解密成功,打開(kāi)文檔,顯示密碼,退出過(guò)程                        Err.Clear               

67、0;    Else                        Label1.Caption = "文檔密碼："                 

68、       Text1.Text = pass                        Me.Refresh                &

69、#160;       xls.Visible = True                        CmdStartCrack.MousePointer = 0            

70、;            CmdStartCrack.Caption = "開(kāi)始破解"                        blnProcessing = False     &#

71、160;                  Set xls = Nothing                        Exit Sub     

72、;               End If                    DoEvents              &

73、#160;     If Not blnProcessing Then Exit For                Next I                If Not blnProcessing Then Exit For  &#

74、160;         Next K            xls.Quit            Set xls = Nothing        Else      

75、;      For K = Password_Start_Long To Password_End_Long  '破解word開(kāi)始                For I = 0 To ArrayLen K - 1             

76、0;      pass = ""                    Temp = I                    For J = 1

77、To K -                       Temp = Temp ArrayLen                        pass =

78、all_char(Temp Mod ArrayLen) + pass                    Next J                    pass = pass + all_char(I Mod A

79、rrayLen)                    OpenReturn = wd.Documents.Open(FileName:=strpath, passworddocument:=pass)                 &#

80、160;  Text1.Text = pass  '顯示破解進(jìn)度                    Text1.Refresh                    If Err.Numb

81、er <> 0 Then    '如果解密成功,打開(kāi)文檔,顯示密碼,退出過(guò)程                        Err.Clear               

82、;     Else                        'MsgBox "word password"                        Label1.Caption = "文檔密碼："