Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
VBAパスワードロック解除(64bit)
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 Long)
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As LongPtr) As Long
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 Long, ByVal pTemplateName As LongPtr, ByVal hWndParent As Long, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As Long) 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
Private Sub RecoverBytes()
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 12
End Sub
Private Function Hook() As Boolean
Dim TmpBytes(0 To 11) As Byte
Dim p As LongPtr
Dim OriginProtect As LongPtr
Hook = False
pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
If VirtualProtect(ByVal pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 12
If TmpBytes(1) <> &HB8 Then
MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 12
p = GetPtr(AddressOf MyDialogBoxParam)
HookBytes(0) = &H48
HookBytes(1) = &HB8
MoveMemory ByVal VarPtr(HookBytes(2)), ByVal VarPtr(p), 8
HookBytes(10) = &H50
HookBytes(11) = &HC3
MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 12
Flag = True
Hook = True
End If
End If
End Function
Private Function MyDialogBoxParam(ByVal hInstance As Long, ByVal pTemplateName As LongPtr, ByVal hWndParent As Long, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As Long) As Integer
If pTemplateName = 4070 Then
MyDialogBoxParam = 1
Else
RecoverBytes
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
hWndParent, lpDialogFunc, dwInitParam)
Hook
End If
End Function
Public 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