Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

File Mapping Class

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin/PBCC File Mapping Class

    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.

    .
    Last edited by Stanley Durham; 1 Aug 2009, 04:44 AM.
    stanthemanstan~gmail
    Dead Theory Walking
    Range Trie Tree
    HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

  • #2
    Code:
    '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
    Last edited by Stanley Durham; 1 Aug 2009, 04:11 AM.
    stanthemanstan~gmail
    Dead Theory Walking
    Range Trie Tree
    HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

    Comment


    • #3
      Code:
      '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
      stanthemanstan~gmail
      Dead Theory Walking
      Range Trie Tree
      HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

      Comment


      • #4
        Code:
        #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
        stanthemanstan~gmail
        Dead Theory Walking
        Range Trie Tree
        HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

        Comment

        Working...
        X