兩種方式破解VBA加密代碼
第一種：
1 Sub VBAPassword1() '你要解保護的Excel文件路徑 2 Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解") 3 If Dir(Filename) = "" Then 4 MsgBox "沒找到相關文件,清重新設置。" 5 Exit Sub 6 Else 7 FileCopy Filename, Filename & ".bak" '備份文件。 8 End If 9 Dim GetData As String * 5 10 Open Filename For Binary As #1 11 Dim CMGs As Long 12 Dim DPBo As Long 13 For i = 1 To LOF(1) 14 Get #1, i, GetData 15 If GetData = "CMG=""" Then CMGs = i 16 If GetData = "[Host" Then DPBo = i - 2: Exit For 17 Next 18 If CMGs = 0 Then 19 MsgBox "請先對VBA編碼設置一個保護密碼...", 32, "提示" 20 Exit Sub 21 End If 22 Dim St As String * 2 23 Dim s20 As String * 1 24 '取得一個0D0A十六進制字串 25 Get #1, CMGs - 2, St 26 '取得一個20十六制字串 27 Get #1, DPBo + 16, s20 28 '替換加密部份機碼 29 For i = CMGs To DPBo Step 2 30 Put #1, i, St 31 Next 32 '加入不配對符號 33 If (DPBo - CMGs) Mod 2 <> 0 Then 34 Put #1, DPBo + 1, s20 35 End If 36 MsgBox "文件解密成功......", 32, "提示" 37 Close #1 38 End Sub
第二種：
1 Option Explicit 2 Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Long, Source As Long, ByVal Length As Long) 3 Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long 4 Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long 5 Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long 6 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 7 Dim HookBytes(0 To 5) As Byte 8 Dim OriginBytes(0 To 5) As Byte 9 Dim pFunc As Long 10 Dim Flag As Boolean 11 Private Function GetPtr(ByVal Value As Long) As Long 12 GetPtr = Value 13 End Function 14 Public Sub RecoverBytes() 15 If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6 16 End Sub 17 Public Function Hook() As Boolean 18 Dim TmpBytes(0 To 5) As Byte 19 Dim p As Long 20 Dim OriginProtect As Long 21 Hook = False 22 pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA") 23 If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) <> 0 Then 24 MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6 25 If TmpBytes(0) <> &H68 Then 26 MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6 27 p = GetPtr(AddressOf MyDialogBoxParam) 28 HookBytes(0) = &H68 29 MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4 30 HookBytes(5) = &HC3 31 MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6 32 Flag = True 33 Hook = True 34 End If 35 End If 36 End Function 37 Private Function MyDialogBoxParam(ByVal hInstance As Long, _ 38 ByVal pTemplateName As Long, ByVal hWndParent As Long, _ 39 ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer 40 If pTemplateName = 4070 Then 41 MyDialogBoxParam = 1 42 Else 43 RecoverBytes 44 MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam) 45 Hook 46 End If 47 End Function 48 Sub Crack() 49 If Hook Then MsgBox "破解成功" 50 End Sub