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

前端 未结 1 920
陌清茗
陌清茗 2020-12-15 12:15

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 ge

相关标签:
1条回答
  • 2020-12-15 12:45

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

    0 讨论(0)
提交回复
热议问题