It's about a dynamic string array within a file. 🚀💾🧮
#DynamicArray #InFile #Programming #Coding #ComputerScience #Tech #DeveloperTools #CodeNewbie #TechCommunity #ArrayHandling
🚀💻🧩💾📊🖥�🔍👨�💻👩�💻✨
Es geht um ein dynamisches String-Array in einer Datei. 📄💻
#DynamischesArray #InFile #Programmierung #Coding #Computerscience #Tech 🚀👨�💻👩�💻🖥�🔍💾
QuoteResults for lurkers:
Function FStrArrOpen(t As FViewT, ByRef file As WString)
create new file or open existing file : true/false success
Sub FStrArrAdd(t As FViewT, ByVal value As String)
append value to end of array
add values
-------
1 = "A"
2 = "B"
3 = "C"
4 = "D"
Function FStrArrGet(t As FViewT, ByVal index As Long) As String
get value at one-based index
Sub FStrArrSet(t As FViewT, ByVal index As Long, ByVal value As String)
set value at one-based index
Get/Set values
-------
1 = "AA"
2 = "BB"
3 = "CC"
4 = "DD"
Sub FStrArrInsert(t As FViewT, ByVal index As Long, ByVal value As String)
insert value at one-based index
insert value at index 2
-------
1 = "AA"
2 = "INSERT"
3 = "BB"
4 = "CC"
5 = "DD"
Sub FStrArrDelete(t As FViewT, ByVal index As Long)
delete value at one-based index
delete value at index 2
-------
1 = "AA"
2 = "BB"
3 = "CC"
4 = "DD"
add 1,000 random strings 5 to 10 characters
Time = 000.047
Count = 1,000
change 1,000 random strings 5 to 10 characters
Time = 000.095
store 100, 1,000,000 character strings
Time = 000.221
get 100, 1,000,000 character strings
Time = 000.284
Sub FStrArrClose(t As FViewT)
close file
'Public domain, use at own risk. SDurham
'In-File Dynamic String Array
'values may contain any kind of binary data
'use ChrToUtf8$()/Utf8ToChr$() for WStrings
'may be UDTs
'may be Mkl$()/Cvl(), ... etc
'may be BMP or icon
'add 1,000 random strings 5 to 10 characters = 0.031 seconds
'change 1,000 random strings 5 to 10 characters = 0.095 seconds
'add 5,000 random strings 5 to 10 characters = 0.141 seconds
'change 5,000 random strings 5 to 10 characters = 0.912 seconds
'store 100, 1,000,000 character strings = 0.219 seconds
'get 100, 1,000,000 character strings = 0.329 seconds
'store 100, 5,000,000 character strings = 0.661 seconds
'get 100, 5,000,000 character strings = 1.194 seconds
#If Not %Def(%FStrArr231203)
%FStrArr231203 = 1
'In-File String Array
Type FViewT
size As Quad 'memory size
hFile As Long
hWinFile As Long
hMap As Long
hView As Long 'memory address
End Type
Function FStrArrOpen(t As FViewT, ByRef file As WString) As Long
'create new file or open existing file : true/false success
If IsFile(file) Then
Function = FVOpenFile(t, file)
ElseIf FVNewFile(t, file, 4) Then
Poke Long, t.hView, 0 : Function = 1
End If
End Function
Sub FStrArrClose(t As FViewT)
'close file
FVClose(t)
End Sub
Sub FStrArrClear(t As FViewT)
'empty container
If t.hView Then
FVResize t, 4
Poke Long, t.hView, 0
End If
End Sub
Function FStrArrCount(t As FViewT) As Long
'get item count
If t.hView Then Function = Peek(Long, t.hView)
End Function
Sub FStrArrAdd(t As FViewT, ByVal value As String)
'append value to end of array
Local lenstr, oldsize, newsize, items As Long : Local p As Long Ptr
lenstr = Len(value)
If t.hView Then
oldsize = t.size
newsize = oldsize + lenstr + 4
If IsFalse FVResize(t, newsize) Then Exit Sub
p = t.hView + oldsize
@p = lenstr : Incr p
Memory Copy StrPtr(value), p, lenstr
p = t.hView : Incr @p
End If
End Sub
Function FStrArrGet(t As FViewT, ByVal index As Long) As String
'get value at one-based index
Local x As Long : Local p As Long Ptr
If index > 0 And index <= FStrArrCount(t) Then
x = 0
p = t.hView + 4
While x < index - 1
Incr x
p += 4 + @p
Wend
Function = Peek$(p + 4, @p)
End If
End Function
Sub FStrArrSet(t As FViewT, ByVal index As Long, ByVal value As String)
'set value at one-based index
Local x, bytes As Long : Local p As Long Ptr : Local s As String
If index > 0 And index <= FStrArrCount(t) Then
x = 0 : bytes = 4 : p = t.hView + 4
While x < index - 1
Incr x
bytes += 4 + @p
p += 4 + @p
Wend
s = Peek$(t.hView, t.size)
s = Left$(s, bytes) + Mkl$(Len(value)) + value + Mid$(s, bytes + 1 + 4 + @p)
If IsFalse FVResize(t, Len(s)) Then Exit Sub
Memory Copy StrPtr(s), t.hView, Len(s)
End If
End Sub
Sub FStrArrInsert(t As FViewT, ByVal index As Long, ByVal value As String)
'insert value at one-based index
Local x, bytes, items As Long : Local p As Long Ptr : Local s As String
If index > 0 And index <= FStrArrCount(t) Then
x = 0 : bytes = 4 : p = t.hView + 4
While x < index - 1
Incr x
bytes += 4 + @p
p += 4 + @p
Wend
s = Peek$(t.hView, t.size)
s = Left$(s, bytes) + Mkl$(Len(value)) + value + Mid$(s, bytes + 1)
If IsFalse FVResize(t, Len(s)) Then Exit Sub
Memory Copy StrPtr(s), t.hView, Len(s)
items = Peek(Long, t.hView) : Incr items : Poke Long, t.hView, items
End If
End Sub
Sub FStrArrDelete(t As FViewT, ByVal index As Long)
'delete value at one-based index
Local x, bytes, items As Long : Local p As Long Ptr : Local s As String
If index > 0 And index <= FStrArrCount(t) Then
x = 0 : bytes = 4 : p = t.hView + 4
While x < index - 1
Incr x
bytes += 4 + @p
p += 4 + @p
Wend
s = Peek$(t.hView, t.size)
s = Left$(s, bytes) + Mid$(s, bytes + 1 + 4 + @p)
If IsFalse FVResize(t, Len(s)) Then Exit Sub
Memory Copy StrPtr(s), t.hView, Len(s)
items = Peek(Long, t.hView) : Decr items : Poke Long, t.hView, items
End If
End Sub
#EndIf '%FStrArr231203
#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�
#Option LargeMem32
#Dim All
#Compile Exe
#Include Once "WIN32API.INC"
#Include Once "..\FileStrArr231113.inc"
%TextBox = 101
%BtnID = 102
Global gDlg As Long
Macro testcount = 1000
Macro teststrsize = 1000000
Sub SampleCode()
Register i As Long
Local arr As FViewT
Local d As Double
Local a() As String
Local s As String
Randomize
Control Set Text gDlg, %TextBox, ""
SS ""
SS "Function FStrArrOpen(t As FViewT, ByRef file As WString)"
SS " create new file or open existing file : true/false success "
If IsFalse FStrArrOpen(arr, "test.data") Then Exit Sub
SS ""
SS "Sub FStrArrAdd(t As FViewT, ByVal value As String)"
SS " append value to end of array"
SS " add values"
FStrArrAdd arr, "A"
FStrArrAdd arr, "B"
FStrArrAdd arr, "C"
FStrArrAdd arr, "D"
SS "-------"
For i = 1 To FStrArrCount(arr)
SS Format$(i) +" = "+ $Dq + FStrArrGet(arr, i) + $Dq
Next i
SS ""
SS "Function FStrArrGet(t As FViewT, ByVal index As Long) As String"
SS " get value at one-based index"
SS "Sub FStrArrSet(t As FViewT, ByVal index As Long, ByVal value As String)"
SS " set value at one-based index"
SS " Get/Set values"
For i = 1 To FStrArrCount(arr)
FStrArrSet arr, i, FStrArrGet(arr, i) + FStrArrGet(arr, i)
Next i
SS "-------"
For i = 1 To FStrArrCount(arr)
SS Format$(i) +" = "+ $Dq + FStrArrGet(arr, i) + $Dq
Next i
SS ""
SS "Sub FStrArrInsert(t As FViewT, ByVal index As Long, ByVal value As String)"
SS " insert value at one-based index"
SS " insert value at index 2"
FStrArrInsert arr, 2, "INSERT"
SS "-------"
For i = 1 To FStrArrCount(arr)
SS Format$(i) +" = "+ $Dq + FStrArrGet(arr, i) + $Dq
Next i
SS ""
SS "Sub FStrArrDelete(t As FViewT, ByVal index As Long)"
SS " delete value at one-based index"
SS " delete value at index 2"
FStrArrDelete arr, 2
SS "-------"
For i = 1 To FStrArrCount(arr)
SS Format$(i) +" = "+ $Dq + FStrArrGet(arr, i) + $Dq
Next i
ReDim a(1 To testcount)
For i = 1 To testcount
a(i) = RandomString()
Next i
SS ""
SS "add "+Format$(testcount,"#,")+" random strings 5 to 10 characters"
FStrArrClear arr
d = Timer
For i = 1 To testcount
FStrArrAdd arr, a(i)
Next i
SS "Time = " + Format$(Timer - d,"000.000")
SS "Count = " + Format$(FStrArrCount(arr),"#,")
For i = 1 To testcount
If FStrArrGet(arr, i) <> a(i) Then ? "array mismatch" : Exit For
Next i
For i = 1 To testcount
a(i) = RandomString()
Next i
SS ""
SS "change "+Format$(testcount,"#,")+" random strings 5 to 10 characters"
For i = 1 To testcount
FStrArrSet arr, i, a(i)
Next i
SS "Time = " + Format$(Timer - d,"000.000")
For i = 1 To testcount
If FStrArrGet(arr, i) <> a(i) Then ? "array mismatch" : Exit For
Next i
SS ""
SS "store 100, "+Format$(teststrsize,"#,")+" character strings"
FStrArrClear arr
s = Repeat$(teststrsize, "X")
For i = 1 To 100
FStrArrAdd arr, s
Next i
SS "Time = " + Format$(Timer - d,"000.000")
SS ""
SS "get 100, "+Format$(teststrsize,"#,")+" character strings"
For i = 1 To 100
If FStrArrGet(arr, i) <> s Then
? "array fail" : Exit For
End If
Next i
SS "Time = " + Format$(Timer - d,"000.000")
SS ""
SS "Sub FStrArrClose(t As FViewT)"
SS " close file"
FStrArrClose arr
Kill "test.data"
SS ""
SS ""
Control Send gDlg, %TextBox, %EM_SETSEL, 1, 1
Control Send gDlg, %TextBox, %EM_SCROLLCARET, 0, 0
End Sub
Function RandomString() As String
Register i As Long
Local s As String
For i = 1 To Rnd(5, 10)
Select Case As Const Rnd(1, 2)
Case 1 : s += Chr$(Rnd(65, 90))
Case 2 : s += Chr$(Rnd(97, 122))
End Select
Next i
Function = s
End Function
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�