PBWin/PBCC File Mapping Class

[Stanley Durham Member Find all posts View Profile Close Stanley Durham]

This class allows you to work with a file as if it’s an allocated block of memory.
File read/write at memory speed.


Use pointers to get/set values in the memory block.
Whatever change you make in the mapped memory block will be made in the file.


This includes PB arrays using Dim At.

You can treat the in-file array as a regular PB array.
Make changes, Scan, Sort – at full memory speed.
All changes reflected in file.
- see sample on how to change array size, preserving data.

you can copy, or download source at bottom of page

This class maps whole file, Read/Write locked.

Special note on changing size of file.
File Mapping is a fixed size.
The Resize() method will close the file view, close file mapping object: change size of file and turn everything back on.

.

[Stanley Durham Member Find all posts View Profile Close Stanley Durham]

'PB 5/9
'FileMapC.inc
    'CREDIT: "Faster File Access With File Mapping"; H. Hern?n Moraldo aka DoctorK
    'http://www.flipcode.com/archives/Faster_File_Access_With_File_Mapping.shtml
    '
    '   API File Mapping Class
    '
    '   !!! Cool Stuff !!!
    '   supper fast file read/write
    '
    '   you use the mapped file as if it's an allocated block of memory
    '   use PB pointer variables to access the memory, make changes, etc...
    '   whatever changes you make, are made in the file
    '
    '   o.New("file", numberOfBytes&)
    '   Local ps As String Ptr
    '   ps = o.MemStart()
    '   @ps = "Save this to file. As long as it's <= numberOfBytes&; no problem."
    '   o.Close()
    '
    '   you can store and access UDTs using UDT pointers
    '   Peek$, Peek, Poke$, Pook memory block
    '
    '   [B]!!! PB Arrays - in file - at full speed !!![/B]
    '   number arrays : Yes
    '   fixed string arrays : Yes
    '   ASCIIC string arrays : Yew
    '   UDT arrays : Yes
    '   dynamic string arrays : No
    '   - make sure file is big enough to hold array - use Resize()
    '           - 10,000 element Long array;
    '               -o.Resize(10000 * 4)
    '               - ReDim arr(1 to 10000) AT o.MemStart()
    '               - done deal!
    '               - changes made to array will be in file
    '                   - note: array memory will be dirty
    '
    '   Change dimension of in-file PB array
    '       - change arr() to 20,000 element long array
    '       - o.Resize(20000 * 4)
    '       - ReDim arr(1 to 20000) AT o.MemStart()
    '           - arr(1) to arr(10000) will be unchanged
    '           - arr(10001) to arr(20000) will be dirty memory
    '
    '   LIMITATIONS: as implemented
    '       file opened Read/Write locked - exclusive
    '       whole file mapped
    '       file can't be null
    '       obviously; you have to stay within mapped memory bounds: o.MemStart(), o.MemEnd() (size of file)
    '       probably bad idea to use PB or API file functions while mapping is on, close mapping object first
    '
    '   you need to use Resize() to change size of file while file is open
    '   Caution: pointers will probably be invalid after Resize() - have to get them again based on new file mapping
    '
    '   use New() to open new file
    '   use Open() to open existing file
    '   always Close() when done
    '
    '   MemStart() to get starting memory address
    '       the memory block is the same size as the file
    '
    'public domain - use at your own risk
 
#If Not %Def(%WINAPI)
    #Include Once "WIN32API.INC"
#EndIf
#Include Once "ClassErr.inc"
$FileMapC_ID = Guid$("{D471BC63-544A-4593-8C89-D8CAD3341737}")
$FileMapI_ID = Guid$("{C8B5A559-9B4A-4EBC-8322-B35C6449528A}")
Class FileMapC $FileMapC_ID As Com
    Instance mPath As String    'file path\name
    Instance mFile As Long      'file handle
    Instance mMap As Long       'file mapping object handle
    Instance mView As Long      'view memory start address
    Instance mErr As Long       'error flag
    Instance mErrMsg As String  'error message
    Interface FileMapI $FileMapI_ID : Inherit IUnknown
        Method New(ByVal file As String, ByVal fileSize As Long) As Long
            'create new file - fileSize length
            'open file for use
            '   Note: can't create empty file
            '   (can't use file mapping on empty)
            Local hFile As Long
            Local s As String
            mErr = %FALSE
            mFile = %NULL
            mMap = %NULL
            mView = %NULL
            MExitTrue(IsFile(file), "file already exist")
            MExitFalse(fileSize, "can't use file mapping on empty file")
            Try
                hFile = FreeFile
                Open file For Binary As hFile Base = 0
                s = Nul$(fileSize)
                Put hFile, 0, s
                Close hFile
            Catch
                MExitTrue(%TRUE, "file creation failed")
            End Try
            Method = me.Open(file)
        End Method
        Method Open(ByVal file As String) As Long
            'open existing file
            'True/False success
            '   fail if file empty
            mErr = %FALSE
            mFile = %NULL
            mMap = %NULL
            mView = %NULL
            mPath = file
            me.FileOpen() : If mErr Then Exit Method
            me.MapOpen() : If mErr Then GoTo CLOSE_FILE
            me.ViewOpen() : If mErr Then GoTo CLOSE_FILE
            Method = %TRUE
            Exit Method
            CLOSE_FILE:
            me.Close
        End Method
        Method Close()
            'close file
            mErr = %FALSE
            MExitFalse(mFile, "file not open")
            me.ViewClose()
            me.MapClose()
            me.FileClose()
            mFile = %NULL
            mMap = %NULL
            mView = %NULL
        End Method
        Method IsErr() As Long
            Method = mErr
        End Method
        Method ErrMsg() As String
            If mErr Then Method = mErrMsg
        End Method
        Method MemStart() As Long
            'return memory address to beginning of File View
            '   you can read/alter memory from MemStart() to MemEnd()
            '   whatever changes you make will be changed in mapped file
            MExitFalse(mFile, "file not open")
            MExitFalse(mMap, "file mapping object not open")
            MExitFalse(mView, "file view not open")
            Method = mView
        End Method
        Method MemCount() As Long
            'get size of mapped file
            '   you can read/alter memory at MemStart() for MemCount() -1 bytes
            MExitFalse(mFile, "file not open")
            MExitFalse(mMap, "file mapping object not open")
            MExitFalse(mView, "file view not open")
            Method = me.GetLOF()
        End Method
        Method MemEnd() As Long
            'get memory address of mapped file
            '   you can read/alter memory from MemStart() to MemEnd()
            MExitFalse(mFile, "file not open")
            MExitFalse(mMap, "file mapping object not open")
            MExitFalse(mView, "file view not open")
            Method = mView + me.GetLOF() - 1
        End Method
        Method LengthOfFile() As Long
            'get length of open file
            Method = me.GetLOF()
        End Method
        Method Resize(ByVal newFileSize As Long)
            'file mapping needs to be turned off before changing size of file
            '   turn file mapping off
            '   resize file
            '   turn file mapping back on
            '       you can't set the size to zero
            MExitFalse(mFile, "file not open")
            MExitTrue(newFileSize <= 0, "can't use file mapping on empty file")
            me.ViewClose()
            me.MapClose()
            SetFilePointer(mFile, newFileSize, %NULL, %FILE_BEGIN)
            SetEndOfFile(mFile)
            me.MapOpen()
            me.ViewOpen()
        End Method
    End Interface
    Class Method FileOpen()
        Local pz As Asciiz Ptr
        mErr = %FALSE
        mFile = %NULL
        mMap = %NULL
        mView = %NULL
        MExitFalse(IsFile(mPath), "file not found")
        pz = StrPtr(mPath)
        mFile = CreateFile(@pz, %GENERIC_READ Or %GENERIC_WRITE, %NULL, ByVal %NULL, %OPEN_EXISTING, %FILE_ATTRIBUTE_NORMAL, %NULL)
        MExitFalse(mFile, "file open failed")
    End Method
    Class Method FileClose()
        mErr = %FALSE
        MExitFalse(mFile, "file not open")
        CloseHandle(mFile)
        mFile = %NULL
    End Method
    Class Method MapOpen()
        'open file mapping object
        mErr = %FALSE
        mMap = %NULL
        mView = %NULL
        MExitFalse(mFile, "file not open")
        MExitFalse(me.GetLOF(), "empty file")
        mMap = CreateFileMapping(mFile, ByVal %NULL, %PAGE_READWRITE, 0, 0, ByVal %NULL)
        MExitFalse(mMap, "file mapping failed")
    End Method
    Class Method MapClose()
        mErr = %FALSE
        MExitFalse(mFile, "file not open")
        MExitFalse(mMap, "file mapping object not open")
        CloseHandle(mMap)
        mMap = %NULL
    End Method
    Class Method ViewOpen()
        mErr = %FALSE
        mView = %NULL
        MExitFalse(mFile, "file not open")
        MExitFalse(mMap, "file mapping object not open")
        mView = MapViewOfFile(mMap, %FILE_MAP_ALL_ACCESS, 0, 0, 0)
        MExitFalse(mView, "file view failed")
    End Method
    Class Method ViewClose()
        mErr = %FALSE
        MExitFalse(mFile, "file not open")
        MExitFalse(mMap, "file mapping object not open")
        MExitFalse(mView, "file view not open")
        UnmapViewOfFile(mView)
        mView = %NULL
    End Method
    Class Method GetLOF() As Long
        'get length of open file
        Local lpFileSizeHigh As Long
        mErr = %FALSE
        MExitFalse(mFile, "file not open")
        Method = GetFileSize(mFile, lpFileSizeHigh)
    End Method
End Class

[Stanley Durham Member Find all posts View Profile Close Stanley Durham]

'ClassErr.inc
    '
    '   error handling macros
    'IMPORTANT!
    '   all classes have to have the SAME error flag & error message string variables
    '
    '   change to suit you're style of programming
Macro McClassErrFlag = mErr     'LONG - error flag variable
Macro McClassErrStr = mErrMsg   'STRING - error message string
Macro MExitFalse(test, msg)
    'Exit Method if test = False
    '   set error flag True
    '   set error message
    '   print Debug error
    If test Then
    Else
        McClassErrFlag = 1
        McClassErrStr = msg
        #Debug Print FuncName$ +": "+ msg
        Exit Method
    End If
End Macro
Macro PExitFalse(test, msg)
    'Exit Property if test = False
    '   set error flag True
    '   set error message
    '   print Debug error
    If test Then
    Else
        McClassErrFlag = 1
        McClassErrStr = msg
        #Debug Print FuncName$ +": "+ msg
        Exit Property
    End If
End Macro
Macro MExitTrue(test, msg)
    'Exit Method if test = True
    '   set error flag True
    '   set error message
    '   print Debug error
    If test Then
        McClassErrFlag = 1
        McClassErrStr = msg
        #Debug Print FuncName$ +": "+ msg
        Exit Method
    End If
End Macro
Macro PExitTrue(test, msg)
    'Exit Property if test = True
    '   set error flag True
    '   set error message
    '   print Debug error
    If test Then
        McClassErrFlag = 1
        McClassErrStr = msg
        #Debug Print FuncName$ +": "+ msg
        Exit Property
    End If
End Macro
Macro GoFalse(test, msg, MARKER)
    'GOTO MARKER if test = False
    '   set error flag True
    '   set error message
    '   print Debug error
    If test Then
    Else
        McClassErrFlag = 1
        McClassErrStr = msg
        #Debug Print FuncName$ +": "+ msg
        GoTo MARKER
    End If
End Macro
Macro GoTrue(test, msg, MARKER)
    'GOTO MARKER if test = True
    '   set error flag True
    '   set error message
    '   print Debug error
    If test Then
        McClassErrFlag = 1
        McClassErrStr = msg
        #Debug Print FuncName$ +": "+ msg
        GoTo MARKER
    End If
End Macro

[Stanley Durham Member Find all posts View Profile Close Stanley Durham]

#PBForms CREATED V1.51
'pbwin 9
$TestSource = "FileMapTest.bas"
$TestTitle = "File Mapping Class Test"
#Compile Exe "FileMapTest.exe"
#Dim All
#Optimize Speed
#Include "FileMapC.inc"
#PBForms BEGIN INCLUDES
#If Not %Def(%WINAPI)
    #Include Once "WIN32API.INC"
#EndIf
#Include Once "PBForms.INC"
#PBForms END INCLUDES
#PBForms BEGIN CONSTANTS
%Dlg1    =  101
%BtnTest = 1002
%Lbx1    = 1001
#PBForms END CONSTANTS
Declare CallBack Function ShowDlg1Proc()
Declare Function ShowDlg1(ByVal hParent As Dword) As Long
#PBForms DECLARATIONS
Global lbx As LBxI
Global tmr As TimerI
Function PBMain()
    ShowDlg1 %HWND_Desktop
End Function
Sub BtnTest(ByVal hDlg As Long)
    Local i, j, hFile, hMem As Long
    Local pb As Byte Ptr
    Local fileName As String : fileName = "FielMap.dat"
    Local file As FileMapI : file = Class "FileMapC"
    Local s As String
    Local arr() As Long
    lbx.Clear(2)
    If IsNothing(file) Then Exit Sub
    If IsFile(fileName) Then Kill fileName
    file.New(fileName, 26)
    If file.IsErr() Then
        ? file.ErrMsg() : Exit Sub
    End If
    lbx.Add("file is open")
    lbx.Add("")
    lbx.Add("make changes to mapped memory using a BYTE pointer")
    pb = file.MemStart()
    If file.IsErr() Then
        ? file.ErrMsg() : Exit Sub
    End If
    j = 96
    For i = 0 To 25
        Incr j
        @pb[i] = j
    Next i
    lbx.Add("")
    lbx.Add("close file mapping object")
    file.Close()
    lbx.Add("")
    lbx.Add("open file using PB function, read file contents")
    hFile = FreeFile
    Open fileName For Binary As hFile Base = 0
    Get$ hFile, 26, s
    lbx.Add("file = '"+s+"'")
    Close hFile
    lbx.Add("")
    lbx.Add("reopen file using File Mapping Class")
    lbx.Add("test Resize()")
    lbx.Add("   File Mapping is fixed size - can't resize")
    lbx.Add("       Resize() closes file mapping")
    lbx.Add("       changes size")
    lbx.Add("       turns back on to new size")
    file.Open(fileName)
    file.Resize(52)
    lbx.Add("")
    lbx.Add("fill new area using BYTE pointer")
    pb = file.MemStart() + 26
    j = 96
    For i = 0 To 25
        Incr j
        @pb[i] = j
    Next i
    lbx.Add("")
    lbx.Add("close file mapping object")
    file.Close()
    lbx.Add("")
    lbx.Add("open file using PB function, read file contents")
    hFile = FreeFile
    Open fileName For Binary As hFile Base = 0
    Get$ hFile, 54, s
    lbx.Add("file = '"+s+"'")
    Close hFile
    lbx.Add("")
    lbx.Add("reopen file using File Mapping Class")
    lbx.Add("change all characters to UCase(), using Peek$()")
    file.Open(fileName)
    hMem = file.MemStart()
    s = Peek$(hMem, 54)
    s = UCase$(s)
    Poke$ hMem, s
    lbx.Add("")
    lbx.Add("close file mapping object")
    file.Close()
    lbx.Add("")
    lbx.Add("open file using PB function, read file contents")
    hFile = FreeFile
    Open fileName For Binary As hFile Base = 0
    Get$ hFile, 54, s
    lbx.Add("file = '"+s+"'")
    Close hFile
    lbx.Add("")
    lbx.Add("reopen file using File Mapping Class")
    lbx.Add("How about an array() using ReDim() AT?")
    file.Open(fileName)
    lbx.Add("resize file for 10,000 element Long array")
    lbx.Add("fill array")
    file.Resize(10000 * 4)
    hMem = file.MemStart()
    ReDim arr(1 To 1000) At hMem
    tmr.Start()
    For i = 1 To 10000
        arr(i) = i
    Next i
    lbx.Add(tmr.Get())
    lbx.Add("")
    lbx.Add("close and reopen file mapping")
    file.Close()
    file.Open(fileName)
    lbx.Add("")
    lbx.Add("get all elements - make sure array actually in file")
    hMem = file.MemStart()
    ReDim arr(1 To 1000) At hMem
    tmr.Start()
    For i = 1 To 10000
        If arr(i) <> i Then
            ? "missing at: " + Format$(i)
            Exit For
        End If
    Next i
    lbx.Add(tmr.Get())
    lbx.Add("")
    lbx.Add("we can't change the size of the array using ReDim()")
    lbx.Add("   just Resize() the file")
    lbx.Add("   change array() to 20,000 elements")
    file.Resize(20000 * 4)
    lbx.Add("   Note: we have to reestablish the beginning of the array after Resize()")
    hMem = file.MemStart()
    ReDim arr(1 To 2000) At hMem
    lbx.Add("fill new elements in array")
    For i = 10001 To 20000
        arr(i) = i
    Next i
    lbx.Add("")
    lbx.Add("close and reopen file mapping")
    lbx.Add("make sure all 20,000 elements in array")
    file.Close()
    file.Open(fileName)
    hMem = file.MemStart()
    tmr.Start()
    For i = 1 To 20000
        If arr(i) <> i Then
            ? "missing at: " + Format$(i)
            Exit For
        End If
    Next i
    lbx.Add(tmr.Get())

    file.Close()
    lbx.Add("")
    lbx.Add("done...")
End Sub
CallBack Function ShowDlg1Proc()
    Select Case As Long CbMsg
        Case %WM_InitDialog
             lbx = Class "LBxC"
             lbx.INI(Cb.Hndl, %Lbx1)
             lbx.SetHorizontal(1000)
             tmr = Class "TimerC"
        Case %WM_NCActivate
            Static hWndSaveFocus As Dword
            If IsFalse CbWParam Then
                hWndSaveFocus = GetFocus()
            ElseIf hWndSaveFocus Then
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            End If
        Case %WM_Command
            Select Case As Long CbCtl
                Case %BtnTest
                    If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                        BtnTest(Cb.Hndl)
                    End If
            End Select
    End Select
End Function
Function ShowDlg1(ByVal hParent As Dword) As Long
    Local lRslt  As Long
#PBForms BEGIN DIALOG %Dlg1->->
    Local hDlg   As Dword
    Local hFont1 As Dword
    Dialog New hParent, $TestTitle, 67, 61, 341, 241, %WS_Popup _
        Or %WS_Border Or %WS_DlgFrame Or %WS_Caption Or %WS_SysMenu Or _
        %WS_MinimizeBox Or %WS_ClipSiblings Or %WS_Visible Or %DS_ModalFrame _
        Or %DS_3DLook Or %DS_NoFailCreate Or %DS_SetFont, _
        %WS_Ex_ControlParent Or %WS_Ex_Left Or %WS_Ex_LtrReading Or _
        %WS_Ex_RightScrollbar, To hDlg
    Control Add ListBox, hDlg, %Lbx1, , 5, 5, 330, 210, %WS_Child Or _
        %WS_Visible Or %WS_HScroll Or %WS_VScroll Or %LBS_Notify Or _
        %LBS_NoIntegralHeight, %WS_Ex_ClientEdge Or %WS_Ex_Left Or _
        %WS_Ex_LtrReading Or %WS_Ex_RightScrollbar
    Control Add Button,  hDlg, %BtnTest, "Test", 275, 220, 60, 15
    hFont1 = PBFormsMakeFont("Courier New", 9, 400, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)
    Control Send hDlg, %Lbx1, %WM_SETFONT, hFont1, 0
#PBForms END DIALOG
    Dialog Show Modal hDlg, Call ShowDlg1Proc To lRslt
#PBForms BEGIN CLEANUP %Dlg1
    DeleteObject hFont1
#PBForms END CLEANUP
    Function = lRslt
End Function
Class LBxC
    Instance meHDlg As Long
    Instance meID As Long
    Interface LBxI
        Inherit IUnknown
        Method INI(ByVal hDlg As Long, ByVal Id As Long)
            meHDlg = hDlg
            meID = Id
        End Method
        Method SetHorizontal(ByVal Count As Long)
            Local hCntrl&
            Control Handle meHDlg, meID To hCntrl&
            SendMessage hCntrl&, %LB_SETHORIZONTALEXTENT, Count, 0
        End Method
        Method Clear(Opt doEventsCount As Long)
            ListBox Reset meHDlg, meID
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
        Method Add(ByVal s As String, Opt doEventsCount As Long) As String
            ListBox Add meHDlg, meID, s
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
    End Interface
    Class Method DoEventsCount(ByVal Count As Long)
        Local i As Long
        For i = 1 To Count
            Dialog DoEvents
        Next i
    End Method
End Class
Class TimerC
    Instance meTime As Double
    Interface TimerI
        Inherit IUnknown
        Method Start()
            meTime = Timer
        End Method
        Method Get() As String
            Method = "    Time: " + Format$(Timer - meTime, "###.###############")
        End Method
    End Interface
End Class