0

I ran this VBA code (below) to break open some protection and it worked like a charm. However, I realized there was a dark side to this solution: I am now unable to restore VBA locking on this file.

When I enter a new password after cracking Excel does not recognize the password and I am forced to run the password cracking VBA again. Any ideas how to restore this feature?

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
    ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As     Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
    ByVal lpProcName As String) As Long

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

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As Long) As Long
GetPtr = Value
End Function

Public 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 Long
Dim OriginProtect As Long

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 Long, _
    ByVal pTemplateName As Long, ByVal hWndParent As Long, _
    ByVal lpDialogFunc As Long, 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
Mathieu Guindon
  • 69,817
  • 8
  • 107
  • 235
  • 1
    Why would you want to password-protect the VBA project anyway? Doesn't this code prove just how pointless this "protection" is? – Mathieu Guindon Nov 01 '17 at 18:24
  • @Mat's Mug - it will keep the uninitiated and clueless from mucking around in a shared file's VBA code. If the user can crack the code, then they most likely will understand the code and not muck it up. – mooseman Nov 01 '17 at 18:30
  • 1
    To be clear, you're trying to lock a cracked/unlocked VBA project *in the same session* as it was unlocked, correct? Does it work if you type `End` in the immediate pane before re-locking? If not, does it work if you close *the host process* (i.e. Excel, not just the VBE's main window - that won't unload it) and then reopen it and *then* try to re-lock it? – Mathieu Guindon Nov 01 '17 at 18:39
  • I agree that the protection fairly weak, but it keeps most N0OBs from damaging formulas and what not. I used the code to break open a file that forgot the password to. However, it seems that the code has ruined the functionality altogether. – Erick Frederick Nov 10 '17 at 18:56

0 Answers0