excel工作表密碼保護，VBA秒破解

Excel VBA工程密碼破解
方法一：破解後可能造成檔打開時出現錯誤，需要修復主控台，之後會丟失vba工程表單和模組。
方法二：此方法對於有表單的程式來說可以查看其表單,但是查看代碼時報未知錯誤.
這兩種方法僅作參考。
excel vba工程密碼是很脆弱的.破解方法網上比比皆是,現總結一下以備無患.
==========================================================
方法一：
新建巨集，執行，選擇需要破解的Excel檔，運行即可。
'1>一段極好的VBA保護密碼破解程式測試WIN98+OFFICE97破解率100%
'2>用以下代碼對VBA加密保護後用offkey 6.5-7.0及Advanced VBA pASSWORD Recovery專業版均無法破解出保護程式碼的密碼
'移除VBA編碼保護
Sub MoveProtect()
Dim FileName As String
FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
If FileName = CStr(False) Then
Exit Sub
Else
VBAPassword FileName, False
End If
End Sub
'設置VBA編碼保護
Sub SetProtect()
Dim FileName As String
FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
If FileName = CStr(False) Then
Exit Sub
Else
VBAPassword FileName, True
End If
End Sub
Private Function 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=""" Then CMGs = i
If GetData = "[Host" Then DPBo = i - 2: Exit For
Next
If CMGs = 0 Then
MsgBox "請先對VBA編碼設置一個保護密碼...", 32, "提示"
Exit Function
End If
If Protect = False Then
Dim St As String * 2
Dim s20 As String * 1
'取得一個0D0A十六進位字串
Get #1, CMGs - 2, St
'取得一個20十六制字串
Get #1, DPBo + 16, s20
'替換加密部份機碼
For i = CMGs To DPBo Step 2
Put #1, i, St
Next
'加入不配對符號
If (DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo + 1, s20
End If
MsgBox "檔解密成功......", 32, "提示"
Else
Dim MMs As String * 5
MMs = "DPB="""
Put #1, CMGs, MMs
MsgBox "對檔特殊加密成功......", 32, "提示"
End If
Close #1
End Function
========================================================
方法二：
使用UltreEdit之類的十六進位編輯程式打開.XLS檔，在文字模式下查找“[Host Extender Info]”(也可只查Host)，切換到十六進位模式，將前面的“DBP＝"XXXXXXX...”的DBP關鍵字改成CBP，將“GC＝ "XXXXXXX...”的GC關鍵字改成CC，使Excel不能識別此二項！存檔即可！！！
用Excel打開此檔，忽略錯誤提
示，進入VBA編輯器，嘿嘿，密碼沒有了！做一次存檔操作即可修復錯誤提示。
vba工程密碼破解（二）API完美版
用API來破解vba工程密碼是我在excelhome中看到的帖子，這邊給他整理成文字，發表在我的空間，希望有這方面需要的朋友可以收藏。還是老話，vba破解請勿用於非法途徑，這是做人基本道德。
這種方法實際是避開VBA工程密碼驗證，即，騙vba編輯器，該密碼輸入成功，請求放行。
原理不多說了，我也是半壺酒。先將方法公佈：
===================================================
1.新建一個工作簿，打開，按ctrl+F11進入vba代碼編輯器視窗：
2.新建一個模組，把以下代碼複製進模組
---------------------------------------------------------------------------------------
Option Explicit
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Long, Source As Long, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean
Private Function GetPtr(ByVal Value As Long) As Long
'獲得函數的位址
GetPtr = Value
End Function
Public Sub RecoverBytes()
'若已經hook,則恢復原API開頭的6位元組,也就是恢復原來函數的功能
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub
Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As Long
Dim OriginProtect As Long
Hook = False
'VBE6.dll調用DialogBoxParamA顯示VB6INTL.dll資源中的第4070號對話方塊(就是輸入密碼的視窗)
'若DialogBoxParamA返回值非0,則VBE會認為密碼正確,所以我們要hook DialogBoxParamA函數
pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
'標準api hook過程之一: 修改記憶體屬性,使其可寫
If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) <> 0 Then
'標準api hook過程之二: 判斷是否已經hook,看看API的第一個位元組是否為&H68,
'若是則說明已經Hook
MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
If TmpBytes(0) <> &H68 Then
'標準api hook過程
之三: 保存原函數開頭位元組,這裡是6個位元組,以備後面恢復
MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
'用AddressOf獲取MyDialogBoxParam的地址
'因為語法不允許寫成p = AddressOf MyDialogBoxParam,這裡我們寫一個函數
'GetPtr,作用僅僅是返回AddressOf MyDialogBoxParam的值,從而實現將
'MyDialogBoxParam的位址付給p的目的
p = GetPtr(AddressOf MyDialogBoxParam)
'標準api hook過程之四: 組裝API入口的新代碼
'HookBytes 組成如下彙編
'push MyDialogBoxParam的地址
'ret
'作用是跳轉到MyDialogBoxParam函數
HookBytes(0) = &H68
MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
HookBytes(5) = &HC3
'標準api hook過程之五: 用HookBytes的內容改寫API前6個位元組
MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
'設置hook成功標誌
Flag = True
Hook = True
End If
End If
End Function
Private Function MyDialogBoxParam(ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
If pTemplateName = 4070 Then
'有程式調用DialogBoxParamA裝入4070號對話方塊,這裡我們直接返回1,讓
'VBE以為密碼正確了
MyDialogBoxParam = 1
Else
'有程式調用DialogBoxParamA,但裝入的不是4070號對話方塊,這裡我們調用
'RecoverBytes函數恢復原來函數的功能,在進行原來的函數
RecoverBytes
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
hWndParent, lpDialogFunc, dwInitParam)
'原來的函數執行完畢,再次hook
Hook
End If
End Function
-------------------------------------------------------------------
3.在sheet1的編輯方塊數加上代碼：
sub 破解()
if hook then
msgbox "破解成功"
end if
end sub
sub 恢復()
RecoverBytes
msgbox "恢復成功"
end sub
4.到此,一個vba破解程式完成了,回到該工作簿視窗,檔-打開 打開需要破解vba工程密碼的工作簿.
5.運行"call 破解" 稍後你再按兩下剛才要解密的VBA工程表單.是不是如入無人之境啊,工程保護密碼形同虛設啊?
6.破解完成後,請右鍵剛破解的VBA工程,在"查看工程時需要密碼"的地方核取方塊取消選擇,OK.完成.
7.完成後別忘了執行"call 恢復",恢復密碼保護(恢復程式的密碼保護,已被破解的檔不收影響).
來源：
https://kknews.cc/zh-tw/tech/m3gk4oz.html