两种方式破解VBA工程加密

2023-09-02 01:36| 来源: 网络整理| 查看: 265

两种方式破解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

本文来自博客园，作者：VBA说，转载请注明原文链接：https://www.cnblogs.com/vbashuo/p/15638693.html

【本文地址】

两种方式破解VBA工程加密

两种方式破解VBA工程加密

今日新闻

推荐新闻