如何使用VBA中的CopyMemory存储数据并从内存映射文件中获取数据？ [英] How to store data in and get data out of memory mapping files using CopyMemory in VBA?
问题描述
我正在尝试构建一个分布式计算系统，它使用内存映射文件来通过VBA来协调多台联网PC之间的工作。换句话说，我想让一组联网的计算机在一个单一的项目上以协调的方式同时进行工作，这个项目可以很容易地分成不同的部分。一台PC需要13多个小时才能完成项目，这对我的客户来说是不实际的。
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.
我想将信息存储在内存映射文件中，这将有助于PC工作在项目上以协调的方式（即不重复工作，避免种族问题等）。我已经尝试使用其他类型的文件来完成此操作，它会导致文件竞争问题或需要太长时间。所以，正如本论坛所建议的，我正在尝试内存映射文件。
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.
我是内存映射文件和分布式计算的全新功能。必须在VBA中完成。据我所知，我必须指定该文件保存在我们网络上的目录（驱动器Z这里），所有PC都可以访问。我已经拼凑了不同地方的代码：
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
作为一个例子，上面的代码尝试将字符串test1放在test1.txt文件中，然后检索该字符串并将其存储在变量buffer2中，最后通过msgbox显示该字符串。超级简单但是，我不知道我在做什么。
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.
我们所有的电脑都是64位，Windows 7，Office / Excel 2013。
All of our PCs are 64bit, Windows 7, Office/Excel 2013.
问题/问题：
- 当我运行IntoMemoryFileOutOfMemoryFile
- 我想让这些内存文件持续存在，所以如果所有的PC都中断，我可以重新启动进程并将其取消。
以下是我以前获得的一些链接：
Here are some of the links that I used to get where I am now:
http://vb.mvps.org /hardcore/html/sharedmemorythroughmemory-mappedfiles.htm
http://www.tushar-mehta.com/publish_train/xl_vba_cases/1016%20Office%202010%20VBA.shtml
有趣的但不重要的信息：项目是针对对冲基金客户。我是一名金融家，我们每天在超过1250多个数据领域分析2000+以上的股票，使宏观经济信号/预测买卖股票，期货和期权。
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.
更新：如果我分别更改了两个CopyMemory行（通过值传递pMemFile）：
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
我在文件test1.txt和excel崩溃中收到一堆疯狂的字符。
I get a bunch of crazy characters in file test1.txt and excel crashes.
推荐答案
你的第一个问题（没有探索太多），这与您如何尝试将缓冲区传递给RtlMoveMemory有关。它期待一个指针，但你传递一个 BSTR 。还要记住，VBA中的一个字符串是Unicode，所以你将得到交织的空字符。我通常使用字节数组或变体（它们将被编组到CSTR）。
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).
对于第二个问题，文件被锁定，因为你永远不会释放处理 hFile 。实际上，一旦将它传递给 CreateFileMappingA ，可以在 hFile上调用。 CloseHandle
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.
对于第三个问题，您将覆盖您的句柄 hMMF 和指针进行第二次呼叫时，pMemFile 在理论上，他们应该返回相同的句柄和指针，就像你在同一个进程中一样，但是这并不能真正测试你是否有地图视图。
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对于内存访问，我可能建议将整个事情包装在Class中，并将指针映射到比调用 RtlMoveMemory 更有用的指针。我将我在该问题中链接的代码改编成一个Class，这样可以使它更安全，更可靠，更方便（尽管还需要通过错误检查来补充）：
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
用法是这样的： / p>
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
您还需要以下声明：
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 ）。
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).
这篇关于如何使用VBA中的CopyMemory存储数据并从内存映射文件中获取数据？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
