vba工程密碼清除

EXCEL vba工程密碼破解

方法一:
這種方法實際是避開VBA工程密碼驗證，即騙vba編輯器，該密碼輸入成功，請求放行。
不管他是破解還是欺騙 能達到我們的目的角開就行
______________________________________________________
1.新建一個工作簿，打開，按ALT+F11，進入vba代碼編輯器窗口：
2.新建一個模塊，“插入”--“模塊”把以下代碼復制進模塊並保存

ption 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 恢復",恢復密碼保護(恢復程序的密碼保護,已被破解的文件不收影響. (請勿用於非法途徑)

已驗證，破解成功

 

方法二:

 

新建一個Excel工作簿,Alt+F11 打開VBA編輯器,新建一個模塊 ,復制以下代碼,注意如提示變量未定義,則把Option Explicit行刪除即可,經測試已經通過.
 
'移除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