VB6 - Treat a file like an array without reading to memory.

[Comintern]

Here's a little snippet of code I posted over on CodeGuru that I thought people over here might be able to make use of. It creates a memory map of a file, meaning that instead of loading the file into memory, it creates a pointer to the file's physical location on the disk. So, you can treat the file as a variable, and any changes you make to the variables are also changing the target file. While useful in and of itself, it's a little limiting without a nice convienent way to index into it (are you thinking array? I am).

The following sample code opens a memory mapped file, creates a byte array, and then modifies the data pointer in the array to point at the file. So, you can do 'reads' with bVar = bByte(x), and 'writes' with bByte(x) = bVar.

It wouldn't be hard to convert from a byte array to another type of array (string excluded, unless the strings were fixed length). All you need to do in that case would be to change the cbElements of the array structure to the size of the chunk of data you want--i.e., if you wanted to treat the file as an array of Longs, cbElements would be 4, a UDT would be LenB(uType), etc. The second type (SafeBound) holds the LBound and UBound information. I wouldn't change the LBound, but you'll want to manually calculate the UBound based on the length of the file and the size of the elements. So, if the file was 1000 bytes and you wanted to treat it as an array of Longs, you would set uTemp.cbElements to 4 and set uTemp.rgsabound.cElements to 249.

Couple of things you might want to do would be to add error checking for the API calls and re-build the original array (mainly just point it back to what it was pointing to before you hacked it) after you remove the memory map to make sure that the memory for the original array data gets de-allocated when it's garbage collected.

Here's the code. This example opens a file and changes the first byte to "=".

'API DECs
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, _
                                                                     ByVal ByteLen As Long)
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
'MEMORY MAPPING APIs
Private Declare Function MapViewOfFile Lib "kernel32.dll" (ByVal hFile As Long, ByVal dwDesiredAccess As Long, _
                                         ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, _
                                         ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function CreateFileMapping Lib "kernel32.dll" Alias "CreateFileMappingA" (ByVal hFile As Long, _
                                         ByVal lpAttributes As Long, ByVal flProtect As Long, _
                                         ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, _
                                         ByVal lpName As String) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32.dll" (ByVal lpBaseAddress As Long) As Boolean
 
'STRUCTS FOR THE SAFEARRAY:
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
 
'MISC CONSTs
Private Const VT_BY_REF = &H4000&
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const MOVEFILE_REPLACE_EXISTING = &H1
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_BEGIN = 0
Private Const CREATE_NEW = 1
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const PAGE_READWRITE = 4
Private Const FILE_MAP_WRITE = &H2
Private Const FILE_MAP_READ = &H4
Private Const FADF_FIXEDSIZE = &H10
 
Private Sub MapFileMemory()
 
    Dim hFile As Long, sFile As String, lPointer As Long, hFileMap As Long, lFileLen As Long, uTemp As SafeArray
    Dim bBytes() As Byte
 
    sFile = "D:\Test2.txt"                              'Set the filename.
                                                        'Map it.
    hFile = CreateFile(sFile, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    hFileMap = CreateFileMapping(hFile, 0, PAGE_READWRITE, 0, 0, "MySharedMapping")
    lPointer = MapViewOfFile(hFileMap, FILE_MAP_WRITE, 0, 0, 0)
 
    bBytes = StrConv("TestTestTest", vbFromUnicode)     'Create an array.
    
    lFileLen = FileLen(sFile)                           'Find the length of the target file.
    
    If GetArrayInfo(bBytes, uTemp) Then                 'Load the UDT with the array info.
        uTemp.cbElements = 1                            'Set element size to a byte.
        uTemp.rgsabound.cElements = lFileLen            'Set the UBound of the array.
        uTemp.fFeature = uTemp.fFeature And FADF_FIXEDSIZE  'Set the "Fixed size" flag, SHOULD MAKE REDIM FAIL!
        uTemp.pvData = lPointer                         'Point it to the memory mapped file as it's data.
        Call AlterArray(bBytes, uTemp)                  'Write the UDT over the old array.
    End If
 
    For lFileLen = LBound(bBytes) To UBound(bBytes)     'This should be reading from the file.
        Debug.Print bBytes(lFileLen)
    Next lFileLen
 
    bBytes(0) = 61                                      'Change the first char to a "=" to see if it worked.
    
    UnmapViewOfFile lPointer                            'Release the memory map.
    CloseHandle hFile                                   'Close the opened file.
 
End Sub
 
Private Function GetArrayInfo(vArray As Variant, uInfo As SafeArray) As Boolean
    
    'NOTE, the array is passed as a variant so we can get it's absolute memory address.  This function
    'loads a copy of the SafeArray structure into the UDT.
    
    Dim lPointer As Long, iVType As Integer
    
    If Not IsArray(vArray) Then Exit Function               'Need to work with a safearray here.
 
    With uInfo
        CopyMemory iVType, vArray, 2                        'First 2 bytes are the subtype.
        CopyMemory lPointer, ByVal VarPtr(vArray) + 8, 4    'Get the pointer.
 
        If (iVType And VT_BY_REF) <> 0 Then                 'Test for subtype "pointer"
            CopyMemory lPointer, ByVal lPointer, 4          'Get the real address.
        End If
        
        CopyMemory uInfo.cDim, ByVal lPointer, 16           'Write the safearray to the passed UDT.
        
        If uInfo.cDim = 1 Then                              'Can't do multi-dimensional
            CopyMemory .rgsabound, ByVal lPointer + 16, LenB(.rgsabound)
            GetArrayInfo = True
        End If
    End With
 
End Function
 
Private Function AlterArray(vArray As Variant, uInfo As SafeArray) As Boolean
    
    'NOTE, the array is passed as a variant so we can get it's absolute memory address.  This function
    'writes the SafeArray UDT information into the actual memory address of the passed array.
    
    Dim lPointer As Long, iVType As Integer
 
    If Not IsArray(vArray) Then Exit Function
 
    With uInfo
        CopyMemory iVType, vArray, 2                        'Get the variant subtype
        CopyMemory lPointer, ByVal VarPtr(vArray) + 8, 4    'Get the pointer.
 
        If (iVType And VT_BY_REF) <> 0 Then                 'Test for subtype "pointer"
            CopyMemory lPointer, ByVal lPointer, 4          'Get the real address.
        End If
 
        CopyMemory ByVal lPointer, uInfo.cDim, 16           'Overwrite the array with the UDT.
 
        If uInfo.cDim = 1 Then                              'Multi-dimensions might wipe out other memory.
            CopyMemory ByVal lPointer + 16, .rgsabound, LenB(.rgsabound)
            AlterArray = True
        End If
 
    End With
 
End Function