




版權(quán)說(shuō)明:本文檔由用戶提供并上傳,收益歸屬內(nèi)容提供方,若內(nèi)容存在侵權(quán),請(qǐng)進(jìn)行舉報(bào)或認(rèn)領(lǐng)
文檔簡(jiǎn)介
1、EXCEL VBA Project密碼破解過(guò)程可能有些繁瑣,EXCEL工作表保護(hù)密碼破解方法: 1打開(kāi)文件 2工具-宏-錄制新宏-輸入名字如:aa 3停止錄制(這樣得到一個(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 password
2、s. 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 '
3、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 McGimpse
4、y" 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.
5、" 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!, BAC
6、KUP!" & _ 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 differ
9、ent 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 Passw
10、ord 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
11、 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 do
12、wn 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 struc
13、ture / 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 I
14、nteger 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
15、.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
16、 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) &
17、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) &
18、amp; 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
19、 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.ProtectC
20、ontents 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 i
21、5 = 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) & C
22、hr(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.Unp
23、rotect 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如何破解VBAProject屬性
24、的保護(hù)密碼1、打開(kāi)任一excel文件2、在宏里粘貼下面的代碼3、運(yùn)行下面的代碼4、選擇需要破解密碼的文件5、點(diǎn)擊“打開(kāi)”'移除VBA編碼保護(hù)Sub MoveProtect()Dim FileName As StringFileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla&*.xlsx),*.xls;*.xla;*.xlsx", , "VBA破解")If FileName = CStr(False) Then Exit SubElse VBAPassword Fi
25、leName, FalseEnd IfEnd Sub'設(shè)置VBA編碼保護(hù)Sub SetProtect()Dim FileName As StringFileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla&*.xlsx),*.xls;*.xla;*.xlsx", , "VBA破解")If FileName = CStr(False) Then Exit SubElse VBAPassword FileName, TrueEnd IfEnd SubPrivate Fu
26、nction VBAPassword(FileName As String, Optional Protect As Boolean = False) If Dir(FileName) = "" Then Exit Function Else FileCopy FileName, FileName & ".bak" End If Dim GetData As String * 5 Open FileName For Binary As #1 Dim CMGs As Long Dim DPBo As Long For i = 1 To LOF(1) Get #1, i, GetData If GetData = "CMG="&q
溫馨提示
- 1. 本站所有資源如無(wú)特殊說(shuō)明,都需要本地電腦安裝OFFICE2007和PDF閱讀器。圖紙軟件為CAD,CAXA,PROE,UG,SolidWorks等.壓縮文件請(qǐng)下載最新的WinRAR軟件解壓。
- 2. 本站的文檔不包含任何第三方提供的附件圖紙等,如果需要附件,請(qǐng)聯(lián)系上傳者。文件的所有權(quán)益歸上傳用戶所有。
- 3. 本站RAR壓縮包中若帶圖紙,網(wǎng)頁(yè)內(nèi)容里面會(huì)有圖紙預(yù)覽,若沒(méi)有圖紙預(yù)覽就沒(méi)有圖紙。
- 4. 未經(jīng)權(quán)益所有人同意不得將文件中的內(nèi)容挪作商業(yè)或盈利用途。
- 5. 人人文庫(kù)網(wǎng)僅提供信息存儲(chǔ)空間,僅對(duì)用戶上傳內(nèi)容的表現(xiàn)方式做保護(hù)處理,對(duì)用戶上傳分享的文檔內(nèi)容本身不做任何修改或編輯,并不能對(duì)任何下載內(nèi)容負(fù)責(zé)。
- 6. 下載文件中如有侵權(quán)或不適當(dāng)內(nèi)容,請(qǐng)與我們聯(lián)系,我們立即糾正。
- 7. 本站不保證下載資源的準(zhǔn)確性、安全性和完整性, 同時(shí)也不承擔(dān)用戶因使用這些下載資源對(duì)自己和他人造成任何形式的傷害或損失。
最新文檔
- 房屋精裝修合同范本
- 護(hù)坡石籠擋墻施工方案
- 醫(yī)療健康示范基地標(biāo)準(zhǔn)廠房項(xiàng)目可行性研究報(bào)告(參考模板)
- 商務(wù)核心區(qū)地塊項(xiàng)目可行性研究報(bào)告
- 物業(yè)綠化工面試題及答案
- 普通沙石路面施工方案
- 醫(yī)療配件組裝方案范本
- 建筑立體綠化工程施工方案
- 標(biāo)志牌挖坑預(yù)埋的施工方案
- 個(gè)人種植勞務(wù)合同范例
- 美容行業(yè):美容師簡(jiǎn)歷
- 2025年甘肅白銀有色集團(tuán)股份有限公司招聘筆試參考題庫(kù)含答案解析
- 2025年上半年安徽明光市事業(yè)單位招聘筆試易考易錯(cuò)模擬試題(共500題)試卷后附參考答案
- 湖北省武漢市2024-2025學(xué)年高三2月調(diào)研考試英語(yǔ)試題
- 教科版三年級(jí)下冊(cè)科學(xué)全冊(cè)同步練習(xí)(一課一練)
- 2025年南京信息職業(yè)技術(shù)學(xué)院?jiǎn)握新殬I(yè)技能測(cè)試題庫(kù)參考答案
- 城市公園景觀設(shè)計(jì)教學(xué)課件
- 2025年阜陽(yáng)職業(yè)技術(shù)學(xué)院?jiǎn)握新殬I(yè)適應(yīng)性測(cè)試題庫(kù)及參考答案
- 【凱度】2025年生鮮消費(fèi)新趨勢(shì)
- 《防波堤施工》課件
- 2025河南中煙安陽(yáng)卷煙廠一線崗位招聘14人易考易錯(cuò)模擬試題(共500題)試卷后附參考答案
評(píng)論
0/150
提交評(píng)論