Как хранить данные и получать данные из файлов сопоставления памяти с помощью 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:pathtest1.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. Очень просто. Однако я понятия не имею, что делаю.
все наши ПК 64bit, Windows 7, Office / Excel 2013.
вопросы:
- msgbox пуст, когда я запускаю IntoMemoryFileOutOfMemoryFile
- после завершения sub я открываю test1.txt и я получаем: "процесс не может получить доступ к файлу, потому что он используется другим процессом."Что говорит мне, что я не использую UnmapViewOfFile и/или CloseHandle правильно.
- я хотел бы сделать эти файлы памяти постоянными, поэтому, если все ПК будут прерваны, я могу перезапустить процесс и пикап на этом я и остановился.
вот некоторые ссылки, которые я использовал, чтобы получить, где я нахожусь теперь:
https://msdn.microsoft.com/en-us/library/dd997372%28v=vs.110%29.aspx
http://vb.mvps.org/hardcore/html/sharedmemorythroughmemory-mappedfiles.htm
http://www.tushar-mehta.com/publish_train/xl_vba_cases/1016%20Office%202010%20VBA.shtml
Интересные, но несущественная информация:" проект " предназначен для клиента хедж-фонда. Я финансист, который стал фундаментальным квантом. Мы ежедневно анализируем акции 2000 + plus более 1250 + полей данных, чтобы сделать макроэкономические сигналы / прогнозы для покупки и продажи акций, фьючерсов и опционов.
UPDATE: если я изменю две строки CopyMemory, как это (передайте pMemFile по значению) соответственно:
CopyMemory ByVal pMemFile, buffer, 128
и...
CopyMemory buffer2, ByVal pMemFile, 128
Я получаю кучу сумасшедших символов в файле тест1.сбой txt и excel.
1 ответов
для вашего первого вопроса (не исследовали его слишком много), это связано с тем, как вы пытаетесь передать свой buffer
в RtlMoveMemory. Он ожидает указатель, но вы передаете ему копию BSTR. Также помните, что строка в VBA является Unicode, поэтому вы получите переплетенные нулевые символы. Обычно я использую либо байтовые массивы, либо варианты (они будут упорядочены до CSTR).
для вашей второй проблемы, файл становится заблокирован, потому что вы никогда не выпускаете ручка к hFile
. На самом деле, как только вы передадите его CreateFileMappingA
можно назвать CloseHandle
on 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).