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

  • Stanley Durham
    replied
    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

    Leave a comment:


  • Stanley Durham
    replied
    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

    Leave a comment:


  • Stanley Durham
    replied
    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.

    Leave a comment:


  • Stanley Durham
    started a topic PBWin/PBCC File Mapping Class

    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.
Working...
X