Как хранить данные и получать данные из файлов сопоставления памяти с помощью CopyMemory в VBA?

Я пытаюсь создать распределенную вычислительную систему, которая использует файлы сопоставления памяти для координации работы между несколькими сетевыми ПК через VBA. Иными словами, я хочу, чтобы группа компьютеров, объединенных в сеть, одновременно и скоординировано работали над одним проектом, который можно было бы легко разделить на разные части. Для завершения проекта на одном компьютере требуется более 13 часов, что нецелесообразно для моего клиента.

Я хочу хранить информацию в файлах сопоставления памяти, которые помогут ПК работать над проектом скоординированно (т. е. без дублирования работы, избегая проблем с гонками и т. д.). Я пытался использовать другие типы файлов для достижения этой цели, но это вызывало проблемы с гонкой за файлами или занимало слишком много времени. Итак, как было предложено на этом форуме, я пытаюсь использовать файлы отображения памяти.

Я новичок в файлах отображения памяти и распределенных вычислениях. Должен быть сделан в VBA. Насколько я знаю, я должен указать, что файл должен быть сохранен в каталоге в нашей сети (здесь диск Z), к которому имеют доступ все ПК. Я собрал код из разных мест:

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

В качестве небольшого примера приведенный выше код пытается поместить строку «testing1» в файл test1.txt, затем извлечь эту строку и сохранить ее в переменной buffer2 и, наконец, отобразить эту строку через окно msgbox. Супер просто. Однако я понятия не имею, что делаю.

Все наши ПК 64-битные, Windows 7, Office/Excel 2013.

Проблемы/вопросы:

  1. msgbox пуст, когда я запускаю IntoMemoryFileOutOfMemoryFile
  2. После завершения подпрограммы я открываю test1.txt и получаю: «Процесс не может получить доступ к файлу, поскольку он используется другим процессом». Что говорит мне, что я неправильно использую UnmapViewOfFile и/или CloseHandle.
  3. Я хотел бы сделать эти файлы памяти постоянными, чтобы, если все компьютеры будут прерваны, я мог перезапустить процесс и продолжить с того места, где остановился.

Вот некоторые из ссылок, которые я использовал, чтобы добраться туда, где я сейчас:

Интересная, но неважная информация: «Проект» предназначен для клиента хедж-фонда. Я финансист, перешедший на фундаментальные количественные расчеты. Мы ежедневно анализируем более 2000 акций в более чем 1250 полях данных, чтобы делать макроэкономические сигналы/прогнозы для покупки и продажи акций, фьючерсов и опционов.

ОБНОВЛЕНИЕ: Если я изменю две строки CopyMemory следующим образом (передаю pMemFile по значению) соответственно:

CopyMemory ByVal pMemFile, buffer, 128

а также...

CopyMemory buffer2, ByVal pMemFile, 128

Я получаю кучу сумасшедших символов в файле test1.txt и происходит сбой excel.


person mountainclimber11    schedule 13.05.2015    source источник
comment
Почему это должен быть VBA? Как бы я ни любил VBA, это похоже на использование молотка, когда вам действительно нужна отвертка.   -  person RubberDuck    schedule 13.05.2015
comment
@RubberDuck Возможно, это требования клиента (у меня такая же проблема для гораздо более простого инструмента), у которых есть кто-то, кто может поддерживать VBA, но не другие языки. Проект непосильный, но интересный, я посмотрю, но ничего не обещаю! ;)   -  person R3uK    schedule 13.05.2015
comment
@RubberDuck - тоже не мой выбор.   -  person mountainclimber11    schedule 13.05.2015
comment
Я не говорил, что это было. Просто говорю, что это может иметь отношение к решению. Возможно, VBA не такое большое требование, как кажется. Знание аргументации могло бы помочь.   -  person RubberDuck    schedule 13.05.2015
comment
@RubberDuck - R3uk прав. Это решение для деловых операций. Это не помешало мне выполнить то, что они хотят... пока.   -  person mountainclimber11    schedule 13.05.2015


Ответы (1)


Для вашей первой проблемы (не исследовал ее слишком много) это связано с тем, как вы пытаетесь передать свой buffer в RtlMoveMemory. Он ожидает указатель, но вы передаете ему копию BSTR. Также помните, что строка в VBA — это Unicode, поэтому вы получите переплетенные нулевые символы. Обычно я использую массивы байтов или варианты (они будут упорядочены до CSTR).

Что касается вашей второй проблемы, файл блокируется, потому что вы никогда не освобождаете дескриптор hFile. На самом деле, как только вы передадите его CreateFileMappingA, вы сможете позвонить CloseHandle на hFile.

Что касается третьей проблемы, вы перезаписываете свой дескриптор hMMF и указатель pMemFile при выполнении второго вызова. Теоретически они должны возвращать тот же дескриптор и указатель, что и вы в том же процессе, но на самом деле это не проверяет, получили ли вы представление карты.

Что касается доступа к памяти, я бы, вероятно, рекомендовал обернуть все это в класс и сопоставить указатель с чем-то более полезным, чем вызовы RtlMoveMemory. Я адаптировал свой код, который вы указали в вопросе, в класс, который должен сделать его немного более безопасным, надежным и удобным в использовании (хотя его все еще необходимо уточнить с проверкой ошибок):

'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

Использование такое:

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

Вам также понадобятся следующие объявления:

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

Следует иметь в виду еще одну вещь: поскольку вы используете сетевой диск, вы должны убедиться, что механизмы кэширования не мешают доступу к файлу. В частности, вы должны убедиться, что на всех клиентах отключено кэширование сетевых файлов. Вы также можете детерминировано сбросить карту памяти, не полагаясь на ОС (см. FlushViewOfFile).

person Comintern    schedule 14.05.2015
comment
Спасибо, но что я упускаю? Я не понимаю, как вы будете получать данные с помощью своего класса MemoryMap. Бывший. мм.ReadData - person mountainclimber11; 23.05.2015
comment
Кроме того, как написать тестовую строку, например testing1, в исходном вопросе? - person mountainclimber11; 23.05.2015
comment
@mountainclimber — реализация класса не завершена. Массив байтов в классе в основном является файлом с отображением памяти, поэтому любые методы доступа будут читать и записывать из buffer. То, как вы его используете, зависит от реализации, но я отредактировал код в ответе для чтения и записи строк. - person Comintern; 23.05.2015
comment
Я читаю строки неизвестной длины, поэтому параметр длины в ReadData работает неправильно. Я думаю о префиксе строки, сохраненной в test.txt, с длиной строки, затем пробелом, затем нужной строкой (так что [string len][space][string]), затем в ReadData выполнение манипуляций со строками (Split (), Mid(), InStr() и т. д.), чтобы получить длину строки и желаемую строку, чтобы я мог избежать параметра длины ReadData. Или есть лучший способ? Мой способ кажется немного неуклюжим. Спасибо. - person mountainclimber11; 24.05.2015
comment
@mountainclimber - Это должно сработать. По сути, это то, что представляет собой bstr: длина, за которой следует сама строка. Еще одно преимущество использования массива VBA для доступа к карте памяти заключается в том, что он дает вам границы, проверяющие, что RtlMoveMemory не будет - для VBA он выглядит как любой другой массив. - person Comintern; 24.05.2015