Déverrouiller le mot de passe VBA à l'aide de scripts VBA

L’édition ou la révision des scripts VBA est essentielle pour améliorer et mettre à jour ses fonctionnalités. Cependant, il arrive un moment où le VBA que vous devez modifier a un mot de passe et vous ne savez pas quoi faire à ce sujet.

Cet article vous montrera comment déverrouiller un mot de passe de script VBA oublié ou inconnu à l’aide de codes VBA.

La logique en bref du mot de passe VBA

1. Le code appellera une fonction système pour créer une boîte de dialogue pour la saisie du mot de passe.
2. La fonction renvoie 1 si le mot de passe est correct. Retournera 0 si ce n’est pas le cas.
3. Après la fermeture de la boîte de dialogue du mot de passe, le système attendra la valeur de retour.
4. Si la valeur de retour est 1, le système l’acceptera comme un mot de passe correct. Ainsi, le projet VBA sera déverrouillé.

Le code ci-dessous montre comment échanger la mémoire de la fonction Password Checker contre une fonction définie par l’utilisateur qui retournera 1 chaque fois qu’elle sera appelée.

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

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

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

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

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

Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LPtr, _
ByVal pTemplateName As LPtr, ByVal hWndParent As LPtr,ByVal lpDialogFunc As LPtr, ByVal dwInitParam As LPtr) As Integer

Dim HBytes(0 To 5) As Byte
Dim OBytes(0 To 5) As Byte
Dim pFunc As LPtr
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As LPtr) As LPtr
    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 LPtr
    Dim OriginProtect As LPtr

    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 LPtr, _
ByVal pTemplateName As LPtr, ByVal hWndParent As LPtr, _
ByVal lpDialogFunc As LPtr, ByVal dwInitParam As LPtr) As Integer

    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                   hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Sub UnprotectedVBACode()
    'Run this subroutine to unlock the VBA project.
    If Hook Then
        Debug.print ("VBA Project was cracked.")
    End If
End Sub