EXCEL密碼破解無需任何工具插件超簡單

1、實(shí)用標(biāo)準(zhǔn)文案此方法無需任何工具只需要按照以下步驟操作就可以破解EXCEL密碼，方便簡單快捷EXCEL密碼破解1打開文件2工具-宏-錄制新宏-輸入名字如:aa3停止錄制(這樣得到一個空宏)4工具-宏-宏,選aa,點(diǎn)編輯按鈕5刪除窗口中的所有字符(只有幾個),替換為下面的內(nèi)容:(復(fù)制吧)6關(guān)閉編輯窗口7工具-宏-宏,選AllInternalPasswords,運(yùn)行,確定兩次,等2分鐘,再確定.OK,沒有密碼了!內(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編程，通過窮舉法解除EXCEL文檔和WORD文檔的密碼。并在破解過程中加入了中斷，以方便用戶隨時中斷破解過程。關(guān)鍵字：窮舉法、解密、EXCEL文檔、WORD文檔、密碼Excel和Word提供了多種方法限制訪問用戶文檔，以免未經(jīng)授權(quán)者的查看和更改。但在信息化的今天，用戶需要記憶的密碼太多，一旦密碼丟失，用戶將無法打開或訪問該文檔，給用戶造成很大的損失。能否借助計算機(jī)的高速運(yùn)行，解開密碼呢？通過嘗試，筆者認(rèn)為：在無法弄清Excel和Word加密算法的情況下，利用窮舉法嘗試解密文檔，是解密唯一的選擇。1. 實(shí)現(xiàn)原理本程序選用VB6.0編寫，并充分利用了Office組件中的

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

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

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

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

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

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

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

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

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

34、ame=ChkBracket，Caption=括號(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=請選擇加密的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=到： 為以上對象編寫下列代碼為了便于理解，程序中增加了適當(dāng)?shù)淖⑨?。Option 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 "錯誤：沒有選擇'密碼使用的字符'", , "請選擇密碼使用的字符范圍."

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

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

56、0;     MsgBox "錯誤：沒有選擇'需要解密的文件'", , "請選擇需要解密的文件."            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開始                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  '如果解密成功,打開文檔,顯示密碼,退出過程                        Err.Clear               

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

68、       Text1.Text = pass                        Me.Refresh                &

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

70、;            CmdStartCrack.Caption = "開始破解"                        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開始                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    '如果解密成功,打開文檔,顯示密碼,退出過程                        Err.Clear               

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