Created
May 14, 2019 21:02
-
-
Save vp777/b9a9b1e1df70d45533c99d944df237d1 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'Originally posted at: https://stackoverflow.com/questions/1026483/is-there-a-way-to-crack-the-password-on-an-excel-vba-project/53358962#53358962 | |
'This version should work for both x86 and amd64 versions of Microsoft Office | |
Option Explicit | |
Private Const PAGE_EXECUTE_READWRITE = &H40 | |
Private 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 LongPtr | |
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr | |
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _ | |
ByVal lpProcName As String) As LongPtr | |
Private 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 Integer | |
Dim HookBytes(0 To 11) As Byte | |
Dim OriginBytes(0 To 11) As Byte | |
Dim pFunc As LongPtr | |
Dim Flag As Boolean | |
Private Function GetPtr(ByVal Value As LongPtr) As LongPtr | |
GetPtr = Value | |
End Function | |
Public Sub RecoverBytes() | |
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 12 | |
End Sub | |
Public Function Hook() As Boolean | |
Dim TmpBytes(0 To 11) As Byte | |
Dim p As LongPtr, osi As Byte | |
Dim OriginProtect As LongPtr | |
Hook = False | |
#If Win64 Then | |
osi = 1 | |
#Else | |
osi = 0 | |
#End If | |
pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA") | |
If VirtualProtect(ByVal pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then | |
MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, osi+1 | |
If TmpBytes(osi) <> &HB8 Then | |
MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 12 | |
p = GetPtr(AddressOf MyDialogBoxParam) | |
If osi Then HookBytes(0) = &H48 | |
HookBytes(osi) = &HB8 | |
osi = osi + 1 | |
MoveMemory ByVal VarPtr(HookBytes(osi)), ByVal VarPtr(p), 4 * osi | |
HookBytes(osi + 4 * osi) = &HFF | |
HookBytes(osi + 4 * osi + 1) = &HE0 | |
MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 12 | |
Flag = True | |
Hook = True | |
End If | |
End If | |
End Function | |
Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _ | |
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _ | |
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer | |
If pTemplateName = 4070 Then | |
MyDialogBoxParam = 1 | |
Else | |
RecoverBytes | |
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _ | |
hWndParent, lpDialogFunc, dwInitParam) | |
Hook | |
End If | |
End Function | |
Sub unprotected() | |
If Hook Then | |
MsgBox "VBA Project is unprotected!", vbInformation, "*****" | |
End If | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment