File Memory Mapping

Started by Theo Gottwald, November 26, 2023, 05:44:55 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Theo Gottwald

Part I: Include-File

'FView231112.inc
'Public domain, use at own risk. SDurham

    'File Memory Mapping
    'once it's open you can treat as regular memory
    'size can be increased or decreased
    'can never be zero
    'FViewT.hView is the memory address
    'FViewT.size if the size of the memory
    '
    '!!! Important !!!
    'anytime size is changed, FViewT.hView may change
    '
    'you can move things around inside the view
    'Poke$ inside the block scares me, I us memory copy.
    'Not so sure the terminating null doesn't sneak in there sometimes.
    '
    'This is simple code and may not be robust enough for some use.

#If Not %Def(%FView231112)
    %FView231112 = 1
    #Include Once "WIN32API.INC"
    #If Not %Def(%Unicode)
        %Unicode = 1
    #EndIf '%Unicode
    Type FViewT
        size As Quad    'memory size
        hFile As Long
        hWinFile As Long
        hMap As Long
        hView As Long   'memory address
    End Type
    Function FVNewFile(t As FViewT, ByVal file As WString, ByVal fileSize As Long) As Long
        'create new file and open for use : can't be zero length : true/false success
        t.size = 0 : t.hFile = 0 : t.hWinFile = 0 : t.hMap = 0 : t.hView = 0
        t.hFile = FreeFile
        If t.hFile Then
            Open file For Binary As t.hFile
            Seek t.hFile, fileSize + 1
            SetEof t.hFile
            t.hWinFile = FileAttr(t.hFile, 2)
            If FVOpenMap(t) And FVOpenView(t) Then
                t.size = fileSize : Function = %true
            Else
                FVCloseView(t) : FVCloseMap(t) : Close t.hFile
                t.size = 0 : t.hFile = 0 : t.hWinFile = 0 : t.hMap = 0 : t.hView = 0
            End If
        End If
    End Function
    Function FVOpenFile(t As FViewT, ByVal file As WString) As Long
        'open existing file : can't be empty file : true/false success
        t.size = 0 : t.hFile = 0 : t.hWinFile = 0 : t.hMap = 0 : t.hView = 0
        If IsFile(file) Then
            t.hFile = FreeFile
            If t.hFile Then
                Open file For Binary As t.hFile
                t.size = Lof(t.hFile)
                If t.size = 0 Then
                    Close t.hFile : t.hFile = 0 : Exit Function
                Else
                    t.hWinFile = FileAttr(t.hFile, 2)
                    If FVOpenMap(t) And FVOpenView(t) Then
                        Function = %true
                    Else
                        FVCloseView(t) : FVCloseMap(t) : Close t.hFile
                        t.size = 0 : t.hFile = 0 : t.hWinFile = 0 : t.hMap = 0 : t.hView = 0
                    End If
                End If
            End If
        End If
    End Function
    Sub FVClose(t As FViewT)
        'close file : file view flushed to disk
        If t.hFile Then
            FVCloseView(t) : FVCloseMap(t) : Close t.hFile
        End If
        t.size = 0 : t.hFile = 0 : t.hWinFile = 0 : t.hMap = 0 : t.hView = 0
    End Sub
    Sub FVFlush(t As FViewT)
        'flush file view to disk : automatically flushed when closed
        If t.hView Then FlushViewOfFile(ByVal t.hView, t.size)
    End Sub
    Function FVResize(t As FViewT, ByVal fileSize As Long) As Long
        'change file view size : must be > 0 : true/false success : view memory address may change
        If t.size And t.hView Then
            FVCloseView(t) : FVCloseMap(t)
            Seek t.hFile, fileSize + 1
            SetEof t.hFile
            t.size = fileSize
            FVOpenMap(t) : FVOpenView(t)
            If IsFalse t.hView Or IsFalse t.hMap Then
                FVCloseView(t) : FVCloseMap(t) : Close t.hFile
                t.size = 0 : t.hFile = 0 : t.hWinFile = 0 : t.hMap = 0 : t.hView = 0
            Else
                Function = %true
            End If
        End If
    End Function
    '-------------------------------
    '   PRIVATE
    '-------------------------------
    Function FVOpenMap(t As FViewT) Private As Long
        'open file mapping : true/false success
        If t.hWinFile Then
            t.hMap = CreateFileMapping(t.hWinFile, ByVal 0, %PAGE_READWRITE, 0, 0, ByVal 0)
            If t.hMap Then Function = %true
        End If
    End Function
    Sub FVCloseMap(t As FViewT) Private
        'close file mapping
        If t.hFile And t.hMap Then
            CloseHandle(t.hMap)
            t.hMap = 0
        End If
    End Sub
    Function FVOpenView(t As FViewT) Private As Byte
        'open file view
        If t.hFile And t.hMap Then
            t.hView = MapViewOfFile(t.hMap, %FILE_MAP_ALL_ACCESS, 0, 0, 0)
            If t.hView Then Function = %true
        End If
    End Function
    Sub FVCloseView(t As FViewT) Private
        'close file view
        If t.hFile And t.hMap And t.hView Then
            UnmapViewOfFile(t.hView)
            t.hView = 0
        End If
    End Sub
#EndIf '%FView231112�

Part II: Testfile
'FView231112.bas
#Option LargeMem32
#Dim All
#Compile Exe
#Include Once "WIN32API.INC"
#Include Once "..\FView231112.inc"

%TextBox = 101
%BtnID = 102
Global gDlg As Long

$FileName = "Test.dat"

Sub SampleCode()
    Local fv As FViewT
    Local s As String
    Local oldsize, strlen, newsize As Long

    Control Set Text gDlg, %TextBox, ""

    SS ""
    SS "Function FVNewFile(t As FViewT, ByVal file As WString, ByVal fileSize As Long) As Long"
    SS "    create new file and open for use : can't be zero length : true/false success"
    SS "        create new file and poke string"
    s = "This is a dynamic String stored in a file."
    FVNewFile(fv, $FileName, Len(s))
    If fv.hView = 0 Then Exit Sub
    Poke$ fv.hView, s

    SS ""
    SS "Sub FVClose(t As FViewT)"
    SS "    close file : file view flushed to disk"
    FVClose fv

    SS ""
    SS "Function FVOpenFile(t As FViewT, ByVal file As WString) As Long"
    SS "    open existing file : can't be empty file : true/false success"
    SS "        get stored String using peek"
    FVOpenFile(fv, $FileName)
    If fv.hView = 0 Then Exit Sub
    SS "string = " + $Dq + Peek$(fv.hView, fv.size) + $Dq
    FVFlush fv
    FVClose fv

    SS ""
    SS "poke string in front of current contents"
    FVOpenFile(fv, $FileName)
    SS "have to increase size"
    s = "This was inserted in front of previous contents. "
    strlen = Len(s)
    oldsize = fv.size
    newsize = oldsize + strlen
    If IsFalse FVResize(fv, newsize) Then Exit Sub
    SS "move old content"
    Memory Copy fv.hView, fv.hView + strlen, strlen
    Poke$ fv.hView, s
    SS "string = " + $Dq + Peek$(fv.hView, fv.size) + $Dq
    FVClose fv

    SS ""
    SS ""

    Control Send gDlg, %TextBox, %EM_SETSEL, 1, 1
    Control Send gDlg, %TextBox, %EM_SCROLLCARET, 0, 0
End Sub

Sub SS(ByVal value As WString)
    'appends without the overhead of getting the text
    Local characterCount As Long
    Local hWin As Long : hWin = GetDlgItem(gDlg, %TextBox)
    value += $CrLf
    characterCount =  SendMessageW(hWin, %WM_GETTEXTLENGTH, 0, 0)
    SendMessageW(hWin, %EM_SETSEL, characterCount, characterCount)
    SendMessageW(hWin, %EM_REPLACESEL, 1, StrPtr(value))
End Sub

Function PBMain()
    Local clientW, clientH As Long
    Desktop Get Client To clientW, clientH
    Dialog Default Font "consolas", 13, 0, 0
    Dialog New 0, Exe.Name$, 0, 0, clientW \ 7, clientH \ 4, %WS_Caption Or %WS_ClipSiblings Or %WS_MinimizeBox Or %WS_SysMenu Or %WS_ThickFrame Or %DS_Center, %WS_Ex_AppWindow To gDlg
    Control Add TextBox, gDlg, %TextBox, "", 0, 0, 0, 0, %ES_AutoHScroll Or %ES_AutoVScroll Or %ES_MultiLine Or %ES_NoHideSel Or %ES_WantReturn Or %WS_HScroll Or %WS_VScroll Or %WS_Border, 0
    Control Add Button,  gDlg, %BtnID, "Run", 275, 220, 60, 15, %BS_Flat, 0
    SendMessageW(GetDlgItem(gDlg, %TextBox), %EM_SETLIMITTEXT, 4000000, 0)
    Dialog Show Modeless gDlg, Call DlgCB
    Do
        Dialog DoEvents
    Loop While IsWin(gDlg)
End Function

CallBack Function DlgCB()
    Select Case As Long Cb.Msg
        Case %WM_Size
            WM_Size()
        Case %WM_Command
            Select Case As Long Cb.Ctl
                Case %BtnID : If Cb.CtlMsg = %BN_Clicked Then SampleCode()
            End Select
    End Select
End Function

Sub WM_Size()
    Local clientW, clientH As Long
    Local marg As Long
    Local buttonW, buttonH As Long
    Local txtWidth, txtHeight As Long
    Local fromLeft, fromBottom As Long
    Dialog Get Client gDlg To clientW, clientH
    marg = 3 : buttonW = 25 : buttonH = 10
    fromLeft = clientW - marg - buttonW
    fromBottom = clientH - marg - buttonH
    Control Set Size gDlg, %BtnID, buttonW, buttonH
    Control Set Loc gDlg, %BtnID, fromLeft, fromBottom
    txtWidth = clientW - marg - marg
    txtHeight = clientH - marg - buttonH - marg - marg
    Control Set Size gDlg, %TextBox, txtWidth, txtHeight
    Control Set Loc gDlg, %TextBox, marg, marg
End Sub�

Source: Powerbasic Forum