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 (https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/828268-file-memory-mapping#post828269)