Skip to content

Instantly share code, notes, and snippets.

@ndthanh
Created November 18, 2018 14:40
Show Gist options
  • Select an option

  • Save ndthanh/7cda75883c1489f7ec828b8f0ff07aa8 to your computer and use it in GitHub Desktop.

Select an option

Save ndthanh/7cda75883c1489f7ec828b8f0ff07aa8 to your computer and use it in GitHub Desktop.

Revisions

  1. ndthanh created this gist Nov 18, 2018.
    81 changes: 81 additions & 0 deletions remove_vba_project_password_64.bas
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,81 @@
    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

    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 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

    Sub unprotected()
    If Hook Then
    MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
    End Sub