VBAのCopyMemoryを使用してメモリマッピングファイルにデータを保存したり、メモリマッピングファイルからデータを取得したりするにはどうすればよいですか?

マウンテンクライマー11

私は、メモリマッピングファイルを使用して、すべてVBAを介して複数のネットワークPC間で作業を調整する分散コンピューティングシステムを構築しようとしています。言い換えれば、ネットワーク化されたコンピューターのグループが、さまざまな部分に簡単に分割できる単一のプロジェクトで、調整された方法で同時に作業できるようにしたいのです。1台のPCでプロジェクトを完了するのに13時間以上かかりますが、これは私のクライアントにとっては実用的ではありません。

PCがプロジェクトで調整された方法で作業するのに役立つ情報をメモリマッピングファイルに保存したいと思います(つまり、作業の重複がない、レースの問題を回避するなど)。他の種類のファイルを使用してこれを実行しようとしましたが、ファイルの競合の問題が発生するか、時間がかかりすぎます。したがって、このフォーラムで提案されているように、私はメモリマッピングファイルを試しています。

私はメモリマッピングファイルと分散コンピューティングにまったく慣れていません。VBAで実行する必要があります。私の知る限り、すべてのPCがアクセスできるネットワーク上のディレクトリ(ここではドライブ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を介してその文字列を表示しようとします。超シンプル。しかし、私は自分が何をしているのか分かりません。

すべてのPCは64ビット、Windows 7、Office / Excel2013です。

問題/質問:

  1. IntoMemoryFileOutOfMemoryFileを実行すると、msgboxが空白になります
  2. サブが完了した後、test1.txtを開くと、「別のプロセスによって使用されているため、プロセスはファイルにアクセスできません。」というメッセージが表示されます。これは、UnmapViewOfFileやCloseHandleを正しく使用していないことを示しています。
  3. これらのメモリファイルを永続的にしたいので、すべてのPCが中断された場合は、中断したところからプロセスとピックアップを再開できます。

これが私が今いる場所にたどり着くために使用したリンクのいくつかです:

興味深いが重要ではない情報:「プロジェクト」はヘッジファンドのクライアント向けです。私は基本的なクオンツアナリストになった財務担当者です。株式、先物、オプションを売買するためのマクロ経済シグナル/予測を行うために、1250以上のデータフィールドで2000以上の株式を毎日分析しています。

更新:2つのCopyMemory行をそれぞれ次のように変更した場合(pMemFileを値で渡します):

CopyMemory ByVal pMemFile, buffer, 128

そして...

CopyMemory buffer2, ByVal pMemFile, 128

test1.txtファイルにクレイジーな文字がたくさんあり、クラッシュに優れています。

コミンテルン

最初の問題(あまり詳しく調べていない)の場合、これはbufferRtlMoveMemoryに渡そうとしている方法に関連していますポインタを期待していますが、BSTRのコピーを渡していますまた、VBAの文字列はUnicodeであるため、null文字が織り交ぜられていることにも注意してください。私は通常、バイト配列またはバリアントのいずれかを使用します(それらはCSTRにマーシャリングされます)。

2番目の問題では、へのハンドルを解放しないため、ファイルがロックされますhFile実際には、できるだけ早くあなたがそれを渡すようCreateFileMappingA、あなたが呼び出すことができますCloseHandlehFile

3番目の問題では、2番目の呼び出しを行うときに、ハンドル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

もう1つ覚えておくべきことは、ネットワークドライブを使用しているため、キャッシュメカニズムがファイルへのアクセスに干渉しないことを確認する必要があることです。具体的には、すべてのクライアントでネットワークファイルのキャッシュがオフになっていることを確認する必要があります。OSに依存する代わりに、メモリマップを決定論的にフラッシュすることもできます(FlushViewOfFileを参照)。

この記事はインターネットから収集されたものであり、転載の際にはソースを示してください。

侵害の場合は、連絡してください[email protected]

編集
0

コメントを追加

0

関連記事

Related 関連記事

ホットタグ

アーカイブ