Private storage for at-rest data in VBA

Question

One major annoyance in VBA programming is that it's hard to keep a secret secret. In this particular case, it's the ADODB.Connection. For reasons not germane to the post, it is necessary to be able to re-create new instances of ADODB.Connection, which also implies filling in the connection string which could contain user's password.

Encryption is OK for data in-transit but for at-rest, and especially within the context of a running application, it's kind of adding complexity for no gain because they can be circumvented. But it happened that I ran across memory protection and realized that surely they had API for and indeed, Windows mostly expose APIs for using virtual memory protection.

In my tests, attempts to read directly from the now-protected memory without appropriate access will GPF the application. Pretty rough, but good in the sense that it means they can't just whittle away trying to hack the application.

However, I'm concerned that it's just another way of encryption and I've added a whole new layer for nothing. I considered using a key but that put me back in the same situation we face with encryption, which after all uses a key... However, I used a class module so that the other objects that needs private storage can instantiate their own instance of the vault. That means we won't be able to count on it being at a certain location, which is also good.

Note that the functions don't really process strings in the conventional manner. The WriteData will take the string ByRef then after it has stored the copy, it will explicitly zero out the input string. Likewise, the ReadData expects the string to be passed ByRef and will write directly to it. I'm dubious whether it actually contributes anything to the security (not considering obscurity), however.

Can we do better? How do we make it usable to only the owning class and not to rest of the VBA project?

NOTE The code is VBA7-only. It is easy enough to make it backward-compatible with VBA6 & earlier, however.

DataVault.cls

Option Explicit

Private Const ModuleName As String = "DataVault"
Private Const NullPtr As LongPtr = &H0

Private Enum AllocationTypes
    MEM_COMMIT = &H1000&            'Allocates memory charges (from the overall size of memory and the paging files on disk) for the specified reserved memory pages. The function also guarantees that when the caller later initially accesses the memory, the contents will be zero. Actual physical pages are not allocated unless/until the virtual addresses are actually accessed. To reserve and commit pages in one step, call VirtualAlloc with MEM_COMMIT | MEM_RESERVE. Attempting to commit a specific address range by specifying MEM_COMMIT without MEM_RESERVE and a non-NULL lpAddress fails unless the entire range has already been reserved. The resulting error code is ERROR_INVALID_ADDRESS. An attempt to commit a page that is already committed does not cause the function to fail. This means that you can commit pages without first determining the current commitment state of each page. If lpAddress specifies an address within an enclave, flAllocationType must be MEM_COMMIT.
    MEM_RESERVE = &H2000&           'Reserves a range of the process's virtual address space without allocating any actual physical storage in memory or in the paging file on disk. You can commit reserved pages in subsequent calls to the VirtualAlloc function. To reserve and commit pages in one step, call VirtualAlloc with MEM_COMMIT | MEM_RESERVE. Other memory allocation functions, such as malloc and LocalAlloc, cannot use a reserved range of memory until it is released.
    MEM_RESET = &H80000             'Indicates that data in the memory range specified by lpAddress and dwSize is no longer of interest. The pages should not be read from or written to the paging file. However, the memory block will be used again later, so it should not be decommitted. This value cannot be used with any other value. Using this value does not guarantee that the range operated on with MEM_RESET will contain zeros. If you want the range to contain zeros, decommit the memory and then recommit it. When you specify MEM_RESET, the VirtualAlloc function ignores the value of flProtect. However, you must still set flProtect to a valid protection value, such as PAGE_NOACCESS. VirtualAlloc returns an error if you use MEM_RESET and the range of memory is mapped to a file. A shared view is only acceptable if it is mapped to a paging file.
    MEM_TOP_DOWN = &H100000         'Allocates memory at the highest possible address. This can be slower than regular allocations, especially when there are many allocations.
    MEM_WRITE_WATCH = &H200000      'Causes the system to track pages that are written to in the allocated region. If you specify this value, you must also specify MEM_RESERVE.
    MEM_PHYSICAL = &H400000         'Reserves an address range that can be used to map Address Windowing Extensions (AWE) pages. This value must be used with MEM_RESERVE and no other values.
    MEM_RESET_UNDO = &H1000000      'MEM_RESET_UNDO should only be called on an address range to which MEM_RESET was successfully applied earlier. It indicates that the data in the specified memory range specified by lpAddress and dwSize is of interest to the caller and attempts to reverse the effects of MEM_RESET. If the function succeeds, that means all data in the specified address range is intact. If the function fails, at least some of the data in the address range has been replaced with zeroes. This value cannot be used with any other value. If MEM_RESET_UNDO is called on an address range which was not MEM_RESET earlier, the behavior is undefined. When you specify MEM_RESET, the VirtualAlloc function ignores the value of flProtect. However, you must still set flProtect to a valid protection value, such as PAGE_NOACCESS.
    MEM_LARGE_PAGES = &H20000000    'Allocates memory using large page support. The size and alignment must be a multiple of the large-page minimum. To obtain this value, use the GetLargePageMinimum function. If you specify this value, you must also specify MEM_RESERVE and MEM_COMMIT.
End Enum

Private Enum ProtectTypes
    PAGE_NOACCESS = &H1&                'Disables all access to the committed region of pages. An attempt to read from, write to, or execute the committed region results in an access violation.
    PAGE_READONLY = &H2&                'Enables read-only access to the committed region of pages. An attempt to write to the committed region results in an access violation. If Data Execution Prevention is enabled, an attempt to execute code in the committed region results in an access violation.
    PAGE_READWRITE = &H4&               'Enables read-only or read/write access to the committed region of pages. If Data Execution Prevention is enabled, attempting to execute code in the committed region results in an access violation.
    PAGE_WRITECOPY = &H8&               'Enables read-only or copy-on-write access to a mapped view of a file mapping object. An attempt to write to a committed copy-on-write page results in a private copy of the page being made for the process. The private page is marked as PAGE_READWRITE, and the change is written to the new page. If Data Execution Prevention is enabled, attempting to execute code in the committed region results in an access violation.
    PAGE_EXECUTE = &H10&                'Enables execute access to the committed region of pages. An attempt to write to the committed region results in an access violation.
    PAGE_EXECUTE_READ = &H20&           'Enables execute or read-only access to the committed region of pages. An attempt to write to the committed region results in an access violation.
    PAGE_EXECUTE_READWRITE = &H40&      'Enables execute, read-only, or read/write access to the committed region of pages.
    PAGE_EXECUTE_WRITECOPY = &H80&      'Enables execute, read-only, or copy-on-write access to a mapped view of a file mapping object. An attempt to write to a committed copy-on-write page results in a private copy of the page being made for the process. The private page is marked as PAGE_EXECUTE_READWRITE, and the change is written to the new page.
    PAGE_GUARD = &H100&                 'Pages in the region become guard pages. Any attempt to access a guard page causes the system to raise a STATUS_GUARD_PAGE_VIOLATION exception and turn off the guard page status. Guard pages thus act as a one-time access alarm.
    PAGE_NOCACHE = &H200                'Sets all pages to be non-cachable. Applications should not use this attribute except when explicitly required for a device. Using the interlocked functions with memory that is mapped with SEC_NOCACHE can result in an EXCEPTION_ILLEGAL_INSTRUCTION exception.
    PAGE_WRITECOMBINE = &H400&          'Sets all pages to be write-combined. Applications should not use this attribute except when explicitly required for a device. Using the interlocked functions with memory that is mapped as write-combined can result in an EXCEPTION_ILLEGAL_INSTRUCTION exception.
    PAGE_TARGETS_INVALID = &H40000000   'Sets all locations in the pages as invalid targets for CFG. Used along with any execute page protection like PAGE_EXECUTE, PAGE_EXECUTE_READ, PAGE_EXECUTE_READWRITE and PAGE_EXECUTE_WRITECOPY. Any indirect call to locations in those pages will fail CFG checks and the process will be terminated. The default behavior for executable pages allocated is to be marked valid call targets for CFG.
    PAGE_TARGETS_NO_UPDATE = &H40000000 'Pages in the region will not have their CFG information updated while the protection changes for VirtualProtect. For example, if the pages in the region was allocated using PAGE_TARGETS_INVALID, then the invalid information will be maintained while the page protection changes. This flag is only valid when the protection changes to an executable type like PAGE_EXECUTE, PAGE_EXECUTE_READ, PAGE_EXECUTE_READWRITE and PAGE_EXECUTE_WRITECOPY. The default behavior for VirtualProtect protection change to executable is to mark all locations as valid call targets for CFG.
End Enum

Private Enum FreeTypes
    MEM_DECOMMIT = &H4000&  'Decommits the specified region of committed pages. After the operation, the pages are in the reserved state. The function does not fail if you attempt to decommit an uncommitted page. This means that you can decommit a range of pages without first determining the current commitment state. Do not use this value with MEM_RELEASE. The MEM_DECOMMIT value is not supported when the lpAddress parameter provides the base address for an enclave.
    MEM_RELEASE = &H8000&   'Releases the specified region of pages. After this operation, the pages are in the free state. If you specify this value, dwSize must be 0 (zero), and lpAddress must point to the base address returned by the VirtualAlloc function when the region is reserved. The function fails if either of these conditions is not met. If any pages in the region are committed currently, the function first decommits, and then releases them. The function does not fail if you attempt to release pages that are in different states, some reserved and some committed. This means that you can release a range of pages without first determining the current commitment state. Do not use this value with MEM_DECOMMIT.
End Enum

Private Declare PtrSafe Function VirtualAlloc Lib "kernel32" ( _
    ByVal lpAddress As LongPtr, _
    ByVal dwSize As LongPtr, _
    ByVal flAllocationType As AllocationTypes, _
    ByVal flProtect As ProtectTypes _
) As LongPtr

Private Declare PtrSafe Function VirtualProtect Lib "kernel32" ( _
    ByVal lpAddress As LongPtr, _
    ByVal dwSize As LongPtr, _
    ByVal flNewProtect As ProtectTypes, _
    ByRef lpflOldProtect As ProtectTypes _
) As Boolean

Private Declare PtrSafe Function VirtualFree Lib "kernel32" ( _
    ByVal lpAddress As LongPtr, _
    ByVal dwSize As LongPtr, _
    ByVal dwFreeType As FreeTypes _
) As Boolean

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As LongPtr, _
    ByVal Source As LongPtr, _
    ByVal Length As LongPtr _
)
Private Type T
    BaseAddress As LongPtr
    VaultSizeInCharacter As LongPtr
    VaultSizeInBytes As LongPtr
    LastDllError As Long
    OldProtectType As ProtectTypes
End Type
Private This As T

Friend Property Get VaultSizeInBytes() As LongPtr
    VaultSizeInBytes = This.VaultSizeInBytes
End Property

Friend Property Get VaultSizeInCharacters() As LongPtr
    VaultSizeInCharacters = This.VaultSizeInCharacter
End Property

Friend Property Get LastDllError() As Long
    LastDllError = This.LastDllError
End Property

Friend Function WriteData(ByRef PrivateString As String) As Boolean
    Dim BufferPointer As LongPtr

    This.VaultSizeInCharacter = Len(PrivateString)
    This.VaultSizeInBytes = LenB(PrivateString)
    This.BaseAddress = VirtualAlloc(NullPtr, This.VaultSizeInBytes, MEM_COMMIT, PAGE_READWRITE)
    If This.BaseAddress Then
        BufferPointer = StrPtr(PrivateString)
        CopyMemory This.BaseAddress, BufferPointer, This.VaultSizeInBytes
        This.LastDllError = Err.LastDllError
    End If

    If This.LastDllError = NullPtr Then
        If VirtualProtect(This.BaseAddress, This.VaultSizeInBytes, PAGE_NOACCESS, This.OldProtectType) = False Then
            This.LastDllError = Err.LastDllError
        End If

        If This.LastDllError = NullPtr Then
            PrivateString = vbNullString
        End If
    End If

    If This.LastDllError Then
        'No point in checking the return because we are in an
        'error state
        ReleaseVault
    End If

    WriteData = ((This.BaseAddress <> NullPtr) And (This.LastDllError = NullPtr))
End Function

Friend Function ReadData(ByRef PrivateString) As Boolean
    Dim OutputBuffer As String
    Dim OutputPointer As LongPtr

    If This.BaseAddress = NullPtr Then
        Err.Raise 5, ModuleName, "Cannot read data; not initialized."
    End If

    OutputBuffer = Space$(This.VaultSizeInCharacter)
    OutputPointer = StrPtr(OutputBuffer)

    If VirtualProtect(This.BaseAddress, This.VaultSizeInBytes, PAGE_READONLY, This.OldProtectType) = False Then
        This.LastDllError = Err.LastDllError
    End If

    If This.LastDllError = NullPtr Then
        CopyMemory OutputPointer, This.BaseAddress, This.VaultSizeInBytes
        This.LastDllError = Err.LastDllError
    End If

    If This.LastDllError = NullPtr Then
        If VirtualProtect(This.BaseAddress, This.VaultSizeInBytes, PAGE_NOACCESS, This.OldProtectType) = False Then
            This.LastDllError = Err.LastDllError
        End If
    End If

    If This.LastDllError = NullPtr Then
        PrivateString = OutputBuffer
        ReadData = Len(PrivateString)
    Else
        'No point in checking the return because we are in an
        'error state
        ReleaseVault
        ReadData = False
    End If
End Function

Private Function ReleaseVault() As Boolean
    ReleaseVault = VirtualFree(This.BaseAddress, NullPtr, MEM_RELEASE)
    This.BaseAddress = NullPtr
    This.VaultSizeInBytes = NullPtr
    This.VaultSizeInCharacter = NullPtr
End Function

Private Sub Class_Terminate()
    ReleaseVault
End Sub

Testing code

Public Sub TryIt()
    Dim Vault As DataVault
    Dim InputString As String
    Dim OutputString As String

    Set Vault = New DataVault

    InputString = "Hello, world!"
    If Vault.WriteData(InputString) Then
        If Vault.ReadData(OutputString) Then
            Debug.Print OutputString = "Hello, world!"
        End If
    End If
End Sub

Answer 1

Love it.

Friend Function WriteData(ByRef PrivateString As String) As Boolean

That should really be Public though. That way if you put that class in its own add-in project and reference it from other VBA projects (instead of importing copies of it every time you need it), then the member is accessible.

Same here:

Friend Function ReadData(ByRef PrivateString) As Boolean

The class otherwise has no Public API, which makes it useless outside the project it exists in.

All that's missing is @Description annotations (and/or VB_Description attributes) on these two members, and you have something pretty neat.

I'd have named T something like TDataVault, and made locals and parameters use camelCase instead of PascalCase, but your casing is consistent anyway, so it doesn't really hurt anything to embrace PascalCase all the way.