如何在VBA中使用CopyMemory在内存映射文件中存储数据并从中获取数据?
我正在尝试构建一个分布式计算系统,它使用内存映射文件来协调多台联网PC机之间的工作,所有这些都是通过VBA实现的。换句话说,我想让一组联网的计算机在一个项目上以协调的方式同时工作,这个项目可以很容易地划分为不同的部分。一台电脑需要13个多小时才能完成项目,这对我的客户来说是不现实的 我希望将信息存储在内存映射文件中,以帮助PC以协调的方式在项目中工作(即无重复工作、避免竞争问题等)。我曾尝试使用其他类型的文件来完成这项工作,但这会导致文件争用问题或耗时过长。所以,正如在这个论坛上所建议的,我正在尝试内存映射文件 我是内存映射文件和分布式计算的新手。必须在VBA中完成。据我所知,我必须指定文件保存在我们网络上的一个目录(这里是驱动器Z)上,所有PC都可以访问该目录。我从不同的地方拼凑了一些代码:如何在VBA中使用CopyMemory在内存映射文件中存储数据并从中获取数据?,vba,excel,distributed-computing,memory-mapping,Vba,Excel,Distributed Computing,Memory Mapping,我正在尝试构建一个分布式计算系统,它使用内存映射文件来协调多台联网PC机之间的工作,所有这些都是通过VBA实现的。换句话说,我想让一组联网的计算机在一个项目上以协调的方式同时工作,这个项目可以很容易地划分为不同的部分。一台电脑需要13个多小时才能完成项目,这对我的客户来说是不现实的 我希望将信息存储在内存映射文件中,以帮助PC以协调的方式在项目中工作(即无重复工作、避免竞争问题等)。我曾尝试使用其他类型的文件来完成这项工作,但这会导致文件争用问题或耗时过长。所以,正如在这个论坛上所建议的,我正在
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
而且
CopyMemory buffer2, ByVal pMemFile, 128
我在文件test1.txt和excel崩溃时遇到了一堆疯狂的字符。对于您的第一个问题(没有过多探讨),这与您如何尝试将缓冲区
传递到RtlMoveMemory有关。它需要一个指针,但您正在传递一个指针的副本。还要记住,VBA中的字符串是Unicode,因此您将得到交织的空字符。我通常使用字节数组或变体(它们将被编组到CSTR)
对于第二个问题,文件被锁定,因为您从未释放hFile
的句柄。事实上,只要将其传递给CreateFileMappingA
,就可以在hFile
上调用CloseHandle
对于第三个问题,当您进行第二次调用时,您正在过度写入句柄hMMF
和指针pMemFile
。理论上,它们应该返回与您在同一进程中相同的句柄和指针,但这并不能真正测试您是否获得地图视图
至于内存访问,我可能会建议将整个内容包装在一个类中,并将指针映射到比调用rtlmovemory
更有用的东西。我将您在问题中链接的代码改编成一个类,使其更安全、更可靠、使用更方便(尽管它仍然需要通过错误检查来充实):
您还需要在某处进行以下声明:
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
还有一件事要记住——因为您使用的是网络驱动器,所以需要确保缓存机制不会干扰对文件的访问。具体来说,您需要确保所有客户端都已关闭网络文件缓存。您可能还希望确定地刷新内存映射,而不是依赖操作系统(请参阅)。为什么必须使用VBA?虽然我很喜欢VBA,但它似乎有点像在你真正需要的是螺丝刀的时候使用锤子。@RubberDuck可能是客户的要求(对于一个更简单的工具,我也遇到了同样的问题),有人能够用VBA进行维护,但不能用其他语言。这个项目超出了我的想象,但很有趣,我会研究它,但不能做出任何承诺!;)@橡胶垫-也不是我的选择。我没说是。只是说它可能与解决方案相关。也许VBA并不像人们想象的那么重要。了解原因可能会有所帮助。@RubberDuck-R3uk是正确的。这是一个商业运营决策。这并没有阻止我实现他们想要的…谢谢,但我错过了什么?我不知道你怎么用MemoryMap类获取数据。此外,如何编写原始问题中的“testing1”之类的测试字符串?@mountainclumber-类实现尚未完成。类中的字节数组基本上是内存映射文件,因此任何访问方法都可以从
缓冲区
读取和写入。如何使用它是特定于执行的,但我在答案中编辑了读写字符串的代码。我正在读取未知长度的字符串,因此ReadData中的“length”参数无法正常工作。我想在test.txt中保存的字符串前面加上字符串的长度,然后加一个空格,然后加上所需的字符串(so[string len][space][string]),然后在ReadData中进行字符串操作(Split()、Mid()、InStr()等)以获得字符串长度和所需字符串,这样我就可以避免使用ReadData length参数。还是有更好的办法?我的路似乎有点笨重。“谢谢,”登山者说,“那应该行。”。这就是bstr的本质,长度后跟字符串本身。使用VBA数组访问内存映射的另一个优点是,它为您提供了检查RtlMoveMemory不会的边界—对于VBA,它看起来像任何其他数组。
'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