【VBA】マクロのパスワードを解除する方法 仕組みと注意点

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 5) As Byte
Dim OriginBytes(0 To 5) 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)), 6
End Sub
   
Public Function Hook() As Boolean
  Dim TmpBytes(0 To 5) As Byte
  Dim p As LongPtr
  Dim OriginProtect As LongPtr
   
  Hook = False
  pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
  If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
    MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
    If TmpBytes(0) <> &H68 Then
      MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
      p = GetPtr(AddressOf MyDialogBoxParam)
      HookBytes(0) = &H68
      MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
      HookBytes(5) = &HC3
      MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
      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
   
Public Sub VBAProjectパスワード解除()
  If Hook Then
    MsgBox "VBAProjectのパスワード解除成功！", vbInformation, "Congratulations"
  End If
End Sub