How to store data in and get data out of memory mapping files using CopyMemory in VBA?

Question

I am trying to build a distributive computing system that uses memory mapping files to coordinate work among several networked PCs all via VBA. Put another way, I want to get a group of networked computers to do work at the same time in a coordinated way on a single project that can be easily divided up into different parts. One PC takes 13+ hours to complete the project, which is not practical for my client.

I want to store information in the memory mapping files that will help the PCs work on the project in a coordinated way (i.e. no duplication of work, avoid race issues, etc). I've tried using other types of files to accomplish this and it causes file race issues or it takes too long. So, as suggested on this forum, I am trying memory mapping files.

I'm brand new to memory mapping files and distributive computing. Has to be done in VBA. As far as I know I have to specify that the file be saved on a directory on our network (drive Z here) that all PCs have access to. I have cobbled together some code from various places:

Option Explicit

Private Const PAGE_READWRITE As Long = &H4
Private Const FILE_MAP_WRITE As Long = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_ALWAYS = 4
Private Const FILE_ATTRIBUTE_NORMAL = &H80

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
                                         ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
                                         ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, _
                                         ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function CreateFileMapping Lib "kernel32.dll" Alias "CreateFileMappingA" ( _
     ByVal hFile As Long, _
     ByVal lpFileMappigAttributes As Long, _
     ByVal flProtect As Long, _
     ByVal dwMaximumSizeHigh As Long, _
     ByVal dwMaximumSizeLow As Long, _
     ByVal lpName As String) As Long

Private Declare Function MapViewOfFile Lib "kernel32.dll" ( _
     ByVal hFileMappingObject As Long, _
     ByVal dwDesiredAccess As Long, _
     ByVal dwFileOffsetHigh As Long, _
     ByVal dwFileOffsetLow As Long, _
     ByVal dwNumberOfBytesToMap As Long) As Long

#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (destination As Any, source As Any, _
    ByVal length As Long)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (destination As Any, source As Any, _
    ByVal length As Long)
    #End If

Private Declare Function UnmapViewOfFile Lib "kernel32.dll" ( _
     ByRef lpBaseAddress As Any) As Long

Private Declare Function CloseHandle Lib "kernel32.dll" ( _
     ByVal hObject As Long) As Long

Private hMMF As Long
Private pMemFile As Long

Sub IntoMemoryFileOutOfMemoryFile()

    Dim sFile As String
    Dim hFile As Long

    sFile = "Z:\path\test1.txt"

    hFile = CreateFile(sFile, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    hMMF = CreateFileMapping(hFile, 0, PAGE_READWRITE, 0, 1000000, "MyMemoryMappedFile")

    pMemFile = MapViewOfFile(hMMF, FILE_MAP_WRITE, 0, 0, 0)

    Dim buffer As String

    buffer = "testing1"
    CopyMemory pMemFile, ByVal buffer, 128

    hMMF = CreateFileMapping(-1, 0, PAGE_READWRITE, 0, 1000000, "MyMemoryMappedFile")
    pMemFile = MapViewOfFile(hMMF, FILE_MAP_WRITE, 0, 0, 0)

     Dim buffer2 As String

    buffer2 = String$(128, vbNullChar)

     CopyMemory ByVal buffer2, pMemFile, 128

     MsgBox buffer2 & " < - it worked?"

     UnmapViewOfFile pMemFile
     CloseHandle hMMF
End Sub

As a little example the code above tries to put the string "testing1" in the file test1.txt then retrieve that string and store it in variable buffer2 and finally display that string via a msgbox. Super simple. However, I have no idea what I am doing.

All of our PCs are 64bit, Windows 7, Office/Excel 2013.

Issues/questions:

1. The msgbox is blank when I run IntoMemoryFileOutOfMemoryFile
2. After the sub is complete I open the test1.txt and I get: "The process cannot access the file because it is being used by another process." Which tells me I am not using UnmapViewOfFile and/or CloseHandle correctly.
3. I'd like to make these memory files persistent so if all PCs are interrupted I can restart the process and pickup where I left off.

Here are some of the links that I used to get where I am now:

• https://msdn.microsoft.com/en-us/library/dd997372%28v=vs.110%29.aspx

• http://www.vbforums.com/showthread.php?404085-VB6-Treat-a-file-like-an-array-without-reading-to-memory

• http://vb.mvps.org/hardcore/html/sharedmemorythroughmemory-mappedfiles.htm

• http://www.tushar-mehta.com/publish_train/xl_vba_cases/1016%20Office%202010%20VBA.shtml

Interesting, but unimportant information: The "project" is for a hedge fund client. I am a finance guy gone fundamental quant. We are analyzing 2000+ plus stocks on a daily basis over 1250+ data fields to make macro economic signals/predictions to buy and sell stocks, futures, and options.

UPDATE: If I change the two CopyMemory lines like this (pass pMemFile by value) respectively:

CopyMemory ByVal pMemFile, buffer, 128

and...

CopyMemory buffer2, ByVal pMemFile, 128

I get a bunch of crazy characters in file test1.txt and excel crashes.

Answer 1

For your first issue (haven't explored it too much), this is related to how you are trying to pass your buffer to the RtlMoveMemory. It's expecting a pointer, but you're passing it a copy of a BSTR. Also remember that a String in VBA is Unicode, so you'll get interwoven null chars. I usually use either Byte arrays or Variants (they'll get marshalled down to a CSTR).

For your second issue, the file is getting locked because you never release the handle to hFile. In fact, as soon as you pass it to CreateFileMappingA, you can call CloseHandle on hFile.

For the third issue, you are over-writing your handle hMMF and the pointer pMemFile when you make the second call. In theory, they should return the same handle and pointer as you're in the same process, but this doesn't really test whether you got the map view.

As for the memory access, I would probably recommend wrapping the whole thing in a Class and mapping the pointer to something more useful than calls to RtlMoveMemory. I adapted my code you linked in the question into a Class that should make it a bit safer and more reliable and convenient to use (although it still needs to be fleshed out with error checking):

'Class MemoryMap
Option Explicit

Private Type SafeBound
    cElements As Long
    lLbound As Long
End Type

Private Type SafeArray
    cDim As Integer
    fFeature As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    rgsabound As SafeBound
End Type

Private Const VT_BY_REF = &H4000&
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const OPEN_ALWAYS = &H4
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const PAGE_READWRITE = &H4
Private Const FILE_MAP_WRITE = &H2
Private Const FADF_FIXEDSIZE = &H10

Private cached As SafeArray
Private buffer() As Byte
Private hFileMap As Long
Private hMM As Long
Private mapped_file As String
Private bound As Long

Public Property Get FileName() As String
    FileName = mapped_file
End Property

Public Property Get length() As Long
    length = bound
End Property

Public Sub WriteData(inVal As String, offset As Long)
    Dim temp() As Byte
    temp = StrConv(inVal, vbFromUnicode)

    Dim index As Integer
    For index = 0 To UBound(temp)
        buffer(index + offset) = temp(index)
    Next index
End Sub

Public Function ReadData(offset, length) As String
    Dim temp() As Byte
    ReDim temp(length)

    Dim index As Integer
    For index = 0 To length - 1
        temp(index) = buffer(index + offset)
    Next index

    ReadData = StrConv(temp, vbUnicode)
End Function

Public Function OpenMapView(file_path As String, size As Long, mapName As String) As Boolean
    bound = size
    mapped_file = file_path

    Dim hFile As Long
    hFile = CreateFile(file_path, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    hFileMap = CreateFileMapping(hFile, 0, PAGE_READWRITE, 0, size, mapName)
    CloseHandle hFile
    hMM = MapViewOfFile(hFileMap, FILE_MAP_WRITE, 0, 0, 0)

    ReDim buffer(2)
    'Cache the original SafeArray structure to allow re-mapping for garbage collection.
    If Not ReadSafeArrayInfo(buffer, cached) Then
        'Something's wrong, close our handles.
        CloseOpenHandles
        Exit Function
    End If

    Dim temp As SafeArray
    If ReadSafeArrayInfo(buffer, temp) Then
        temp.cbElements = 1
        temp.rgsabound.cElements = size
        temp.fFeature = temp.fFeature And FADF_FIXEDSIZE
        temp.pvData = hMM
        OpenMapView = SwapArrayInfo(buffer, temp)
    End If    
End Function

Private Sub Class_Terminate()
    'Point the member array back to its own data for garbage collection.
    If UBound(buffer) = 2 Then
        SwapArrayInfo buffer, cached
    End If
    SwapArrayInfo buffer, cached
    CloseOpenHandles
End Sub

Private Sub CloseOpenHandles()
    If hMM > 0 Then UnmapViewOfFile hMM
    If hFileMap > 0 Then CloseHandle hFileMap
End Sub

Private Function GetBaseAddress(vb_array As Variant) As Long
    Dim vtype As Integer
    'First 2 bytes are the VARENUM.
    CopyMemory vtype, vb_array, 2
    Dim lp As Long
    'Get the data pointer.
    CopyMemory lp, ByVal VarPtr(vb_array) + 8, 4
    'Make sure the VARENUM is a pointer.
    If (vtype And VT_BY_REF) <> 0 Then
        'Dereference it for the actual data address.
        CopyMemory lp, ByVal lp, 4
        GetBaseAddress = lp
    End If
End Function

Private Function ReadSafeArrayInfo(vb_array As Variant, com_array As SafeArray) As Boolean
    If Not IsArray(vb_array) Then Exit Function

    Dim lp As Long
    lp = GetBaseAddress(vb_array)
    If lp > 0 Then
        With com_array
            'Copy it over the passed structure
            CopyMemory .cDim, ByVal lp, 16
            'Currently doesn't support multi-dimensional arrays.
            If .cDim = 1 Then
                CopyMemory .rgsabound, ByVal lp + 16, LenB(.rgsabound)
                ReadSafeArrayInfo = True
            End If
        End With
    End If
End Function

Private Function SwapArrayInfo(vb_array As Variant, com_array As SafeArray) As Boolean
    If Not IsArray(vb_array) Then Exit Function
    Dim lp As Long
    lp = GetBaseAddress(vb_array)

    With com_array
        'Overwrite the passed array with the SafeArray structure.
        CopyMemory ByVal lp, .cDim, 16
        If .cDim = 1 Then
            CopyMemory ByVal lp + 16, .rgsabound, LenB(.rgsabound)
            SwapArrayInfo = True
        End If
    End With    
End Function

Usage is like this:

Private Sub MMTest()
    Dim mm As MemoryMap

    Set mm = New MemoryMap
    If mm.OpenMapView("C:\Dev\test.txt", 1000, "TestMM") Then
        mm.WriteData "testing1", 0
        Debug.Print mm.ReadData(0, 8)
    End If

    Set mm = Nothing
End Sub

You'll also need the following declarations someplace:

Public Declare Function MapViewOfFile Lib "kernel32.dll" ( _
    ByVal hFileMappingObject As Long, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwFileOffsetHigh As Long, _
    ByVal dwFileOffsetLow As Long, _
    ByVal dwNumberOfBytesToMap As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (Destination As Any, Source As Any, _
    ByVal length As Long)

Public Declare Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As Long) As Long

Public Declare Function UnmapViewOfFile Lib "kernel32.dll" ( _
    ByVal lpBaseAddress As Any) As Long

One other thing to keep in mind - since you're using a network drive, you'll want to make sure that the caching mechanisms don't interfere with accesses to the file. Specifically, you'll want to make sure that all of the clients have network file caching turned off. You might also want to flush the memory map deterministically instead of relying on the OS (see FlushViewOfFile).