VBA过程代码密码解除

VBA过程代码密码解除

注：不可恶意破解他人VBA工程。

　　1 打开需解除的Excel，新建一个空白Excel文档

　　2 Alt + F11 打开代码编辑，新建模块将以下代码复制

Option ExplicitPrivate Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtrPrivate Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtrPrivate Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtrPrivate Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As IntegerDim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As LongPtr
Dim Flag As BooleanPrivate Function GetPtr(ByVal Value As LongPtr) As LongPtrGetPtr = Value
End FunctionPublic Sub RecoverBytes()If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End SubPublic Function Hook() As BooleanDim TmpBytes(0 To 5) As ByteDim p As LongPtrDim OriginProtect As LongPtrHook = FalsepFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) <> 0 ThenMoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6If TmpBytes(0) <> &H68 ThenMoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6p = GetPtr(AddressOf MyDialogBoxParam)HookBytes(0) = &H68MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4HookBytes(5) = &HC3MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6Flag = TrueHook = TrueEnd IfEnd If
End FunctionPrivate Function MyDialogBoxParam(ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As IntegerIf pTemplateName = 4070 ThenMyDialogBoxParam = 1ElseRecoverBytesMyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam)HookEnd If
End Function

　　3 点击Sheet1，将以下代码复制

Sub 破解()If Hook ThenMsgBox "破解成功"End IfEnd SubSub 恢复()RecoverBytesMsgBox "恢复成功"End Sub

　　4 运行破解和恢复即可