In-String: String Array and Hash Table

Started by Theo Gottwald, November 26, 2023, 05:56:09 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Print
Go Down Pages1
User actions

Theo Gottwald

November 26, 2023, 05:56:09 PM Last Edit: November 26, 2023, 06:04:27 PM by Theo Gottwald
🧠💾 The data structure is seamlessly integrated within the host string & requires no additional memory management—simply use the string as is. 🚫🗑�

🔗 Its integrity is maintained throughout the string's lifetime, whether stored or transferred. To remain up-to-date, it must be passed by reference. 🔄

📊 The array functions like a buffered stack, complete with array procedures, handling up to 100,000 strings efficiently. However, it slows down with a million. 🐢

🔍 The hash table excels at fast retrieval for 100,000 items but is slower when adding new ones due to its binary insert method. It can manage approximately 25,000 items without a predefined 'capacity' and maintains key order. 🔑

🛠� Utilizing PureBasic's versatile functions (ChrToUtf8$()/Utf8ToChr$, MK.../CV...), these containers can accommodate any standard variable types. The hash table keys can even include nulls. 🚀

🎛� Since these containers are essentially strings, they can be crafted into various structures: arrays of arrays, arrays of hash tables, and even hash tables of arrays. 🧩

📊 With PowerBasic's functions, you can create complex data structures like a table with columns and rows—a sample is provided for reference. 📝

🔄 If a container is nested within another, it must be extracted to access or modify its contents, then stored again if any changes are made. 📦

#DataStructures #Programming #PowerBasic #Coding #Tech #SoftwareDevelopment #ComputerScience #Arrays #HashTables #MemoryManagement #Efficiency #Developers 🖥�🔧📈🧮📊🔍📚👨�💻👩�💻🚀🧠💾

Code Select
'Sarr.bas
'String Array Sample
#Option LargeMem32
#Dim All
#Compile Exe
#Include Once "WIN32API.INC"

#Include Once "..\Sarr.inc"

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

Macro SS = SBdrAddLine stringBuilder,

%TestCount = 10000
%LongString = 100

Sub SampleCode()
    Register i As Long
    Local stringBuilder As String
    Local arr As String
    Local value As String
    Local a() As String
    Local d As Double

    Randomize

    SS ""
    SS "Sub SarrSetMetadata((ByRef container As String, ByVal value As String)"
    SS "    there is SarrMetadataSpace in each container for metadata"
    SS "    set metadata"
    SarrSetMetadata arr, "metadata ..............................................................."

    SS ""
    SS "Function SarrGetMetadata(ByRef container As String) As String"
    SS "    there is SarrMetadataSpace in each container for metadata"
    SS "    get metadata"
    SS "metadata = " + $Dq + SarrGetMetadata(arr) + $Dq

    SS ""
    SS "SarrAdd(ByRef container As String, ByVal value As String)"
    SS "    append value and payload : pass null string to ignore payload"
    SS "        append few values"
    For i = 1 To 5
        value = "value " + Format$(i)
        SarrAdd arr, value
    Next i
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "SSub SarrSet(ByRef container As String, ByVal index As Long, ByVal value As String)"
    SS "    set value at one-based index"
    SS "        change value at index 5"
    SarrSet arr, 5, "last value in array"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Sub SarrInsert(ByRef container As String, ByVal index As Long, ByVal value As String)"
    SS "    insert value at one-based index "
    SS "        insert value at index 2"
    SarrInsert arr, 2, "inserted at index 2"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Sub SarrDelete(ByRef container As String, ByVal index As Long)"
    SS "    delete value at one-based index"
    SS "        delete value at index 2"
    SarrDelete arr, 2
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Sub SarrFastDelete(container$, ByVal index As Long)"
    SS "    fast delete value at one-based index"
    SS "    ffast on massive array but destroys array order"
    SS "    traverse back to front to use"
    SS "        fast delete value at index 1"
    SarrFastDelete arr, 1
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Sub SarrReverse(ByRef container As String)"
    SS "    reverse array"
    SarrReverse arr
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Sub SarrSort(ByRef container As String)"
    SS "    non-recursive quick sort"
    SS "        clear array and add some values"
    SarrClear arr
    SarrAdd arr, "G"
    SarrAdd arr, "C"
    SarrAdd arr, "A"
    SarrAdd arr, "D"
    SarrAdd arr, "B"
    SarrAdd arr, "X"
    SarrAdd arr, "A"
    SarrAdd arr, "C"
    SarrAdd arr, "B"
    SarrAdd arr, "D"
    SarrAdd arr, "C"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i
    SS "        sort array"
    SarrSort arr
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Function SarrSortSearch(ByRef container As String, ByVal value As String, Opt ByVal findFirst As Long, Opt ByVal findLast As Long) As Long"
    SS "    binary search for value : return index : zero if not found : array must be sorted"
    SS "sort search for 'A' = " + Format$(SarrSortSearch(arr, "A"))
    SS "sort search for 'B' = " + Format$(SarrSortSearch(arr, "B"))
    SS "sort search for 'C' = " + Format$(SarrSortSearch(arr, "C"))
    SS "sort search for 'D' = " + Format$(SarrSortSearch(arr, "D"))
    SS "sort search for 'E' = " + Format$(SarrSortSearch(arr, "E"))
    SS "sort search for 'F' = " + Format$(SarrSortSearch(arr, "F"))
    SS "sort search for 'G' = " + Format$(SarrSortSearch(arr, "G"))

    SS ""
    SS "    if IsTrue findFirst then first instance found"
    SS "    if IsTrue findLast then last instance found"
    SS "first instance of 'A' = " + Format$(SarrSortSearch(arr, "A", 1, 0))
    SS "last  instance of 'A' = " + Format$(SarrSortSearch(arr, "A", 0, 1))
    SS "first instance of 'B' = " + Format$(SarrSortSearch(arr, "B", 1, 0))
    SS "last  instance of 'B' = " + Format$(SarrSortSearch(arr, "B", 0, 1))
    SS "first instance of 'C' = " + Format$(SarrSortSearch(arr, "C", 1, 0))
    SS "last  instance of 'C' = " + Format$(SarrSortSearch(arr, "C", 0, 1))
    SS "first instance of 'D' = " + Format$(SarrSortSearch(arr, "D", 1, 0))
    SS "last  instance of 'D' = " + Format$(SarrSortSearch(arr, "D", 0, 1))

    SS ""
    SS "Function SarrSortCount(ByRef container As String, ByVal value As String) As Long"
    SS "    get value's instance count : array must be sorted"
    SS "instances of 'A' = " + Format$(SarrSortCount(arr, "A"))
    SS "instances of 'B' = " + Format$(SarrSortCount(arr, "B"))
    SS "instances of 'C' = " + Format$(SarrSortCount(arr, "C"))

    SS ""
    SS "Sub SarrSortInsert(ByRef container As String, ByVal value As String, Opt ByVal unique As Long)"
    SS "    insert value at sort position : added if empty : array must be sorted or empty"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i
    SS "        sort insert A, B, C"
    SarrSortInsert arr, "A"
    SarrSortInsert arr, "B"
    SarrSortInsert arr, "C"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "    if IsTrue unique then duplicates ignored"
    SS "        sort insert A, B, C, R, Z"
    SarrSortInsert arr, "A", 1
    SarrSortInsert arr, "B", 1
    SarrSortInsert arr, "C", 1
    SarrSortInsert arr, "R", 1
    SarrSortInsert arr, "Z", 1
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Sub SarrSortDelete(ByRef container As String, ByVal value As String)"
    SS "    delete one instance of value if in array maintaining sort order : array must be sorted"
    SS "        sort delete R"
    SarrSortDelete arr, "R"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS ""
    SS "Sub SarrPushFirst(ByRef container As String, ByVal value As String)"
    SS "    insert value at front"
    SS "Sub SarrPushLast(ByRef container As String, ByVal value As String)"
    SS "    append value to end of array"
    SS "Function SarrPopFirst(ByRef container As String) As String"
    SS "    get and remove first value in array"
    SS "Function SarrPopLast(ByRef container As String) As String"
    SS "    get and remove first value in array"

    SS ""
    SS "Stack: SarrPushLast(), SarrPopLast()"
    SS "    push A, B, C on stack"
    SarrClear arr
    SarrPushLast arr, "A"
    SarrPushLast arr, "B"
    SarrPushLast arr, "C"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i
    SS "    pop stack"
    While SarrCount(arr)
        SS "pop = " + $Dq + SarrPopLast(arr) + $Dq
    Wend

    SS ""
    SS "Queue: SarrPushLast(), SarrPopFirst()"
    SS "    add A, B, C to queue"
    SarrClear arr
    SarrPushLast arr, "A"
    SarrPushLast arr, "B"
    SarrPushLast arr, "C"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i
    SS "    pop queue"
    While SarrCount(arr)
        SS "pop = " + $Dq + SarrPopFirst(arr) + $Dq
    Wend

    SS ""
    SS ""
    SS "SarrSplit(ByRef container As String, ByVal delimitedString As String, ByVal delimiter As String)"
    SS "    split array on delimited strin"
    SS "        split array on '1,two,3.33,Four,5.5555' "
    SarrSplit arr, "1,two,3.33,Four,5.5555", ","
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS "Function SarrJoin(ByRef container As String, ByVal delimiter As String) As String"
    SS "    join array to delimited string"
    SS "join = " + $Dq + SarrJoin(arr, ",") + $Dq

    SS ""
    SS ""
    SS "Sub SarrToTextFile(ByRef container As String, ByVal file As WString)"
    SS "    store array as text file"
    SS "        clear array and add text linex"
    SarrClear arr
    SarrAdd arr, "This is line one."
    SarrAdd arr, "The is line two."
    SarrAdd arr, "This is line three."
    SarrAdd arr, "This is the last line."
    SS "        store as text file"
    SarrToTextFile arr, "Text.txt"

    SS ""
    SS "Sub SarrFromTextFile(ByRef container As String, ByVal file As WString)"
    SS "    load text file"
    SarrFromTextFile arr, "Text.txt"
    Kill "Text.txt"
    SS "--- Display Array ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + SarrGet(arr, i) + $Dq
    Next i

    SS ""
    SS ""
    SS "File and Folder List"

    SS ""
    SS "Sub SarrFolders(ByRef container As String, ByVal specifiedFolder As WString)"
    SS "    get all folders in specified folder matching mask"
    SS "    items stored UTF8"
    SS "        load all folders in 'C:\Windows\IME'"
    SarrFolders arr, "C:\Windows\IME"
    SS "--- Display Array Converted From UTF8 ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + Utf8ToChr$(SarrGet(arr, i)) + $Dq
    Next i

    SS ""
    SS "Sub SarrFiles(ByRef container As String, ByVal specifiedFolder As WString, ByVal mask As WString)"
    SS "    get all files in folder matching mask"
    SS "    items stored UTF8 "
    SS "        get all files in 'C:\Windows\IME' matching '*.dll' "
    SarrFiles arr, "C:\Windows\IME", "*.dll"
    SS "--- Display Array Converted From UTF8 ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + Utf8ToChr$(SarrGet(arr, i)) + $Dq
    Next i

    SS ""
    SS "Sub SarrAllFolders(ByRef container As String, ByVal specifiedFolder As WString)"
    SS "    get all folders in specified folder and sub-folders"
    SS "    items stored UTF8"
    SS "        get folders in 'C:\Windows\IME' "
    SarrAllFolders arr, "C:\Windows\IME"
    SS "--- Display Array Converted From UTF8 ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + Utf8ToChr$(SarrGet(arr, i)) + $Dq
    Next i

    SS ""
    SS "Sub SarrAllFiles(ByRef container As String, ByVal specifiedFolder As WString, ByVal mask As WString)"
    SS "    get all files in specified folder, and sub-folders, matching mask"
    SS "    items stored UTF8"
    SS "        get all files in 'C:\Windows\IME' matching '*.dll' "
    SarrAllFiles arr, "C:\Windows\IME", "*.dll"
    SS "--- Display Array Converted From UTF8 ---"
    For i = 1 To SarrCount(arr)
        SS "at "+Format$(i)+" value = " + $Dq + Utf8ToChr$(SarrGet(arr, i)) + $Dq
    Next i

    ReDim a(1 To %TestCount)
    For i = 1 To %TestCount
        a(i) = Format$(Rnd(-222222222, 2222222222))
    Next i


    SS ""
    SS ""
    SS ""
    SS "add "+Format$(%TestCount, "#,")+" values to empty array"
    arr = ""
    d = Timer
    For i = 1 To %TestCount
        SarrAdd arr, a(i)
    Next i
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS "get "+Format$(%TestCount, "#,")+" values"
    d = Timer
    For i = 1 To %TestCount
        If SarrGet(arr, i) <> a(i) Then
            ? "array fail" : Exit For
        End If
    Next i
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS ""
    SS ""
    SS "Sub SarrPack(ByRef container As String)"
    SS "    get rid of dead space"
    SS "container size = " + Format$(Len(arr), "#,") + " bytes"
    SS "pack container"
    d = Timer
    SarrPack arr
    SS "Time = " + Format$(Timer - d, "000.000")
    SS "container size = " + Format$(Len(arr), "#,") + " bytes"

    SS ""
    SS ""
    SS ""
    SS "sort array of "+Format$(%TestCount, "#,")+" random values"
    d = Timer
    SarrSort arr
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS "binary search array for "+Format$(%TestCount, "#,")+" values"
    d = Timer
    For i = 1 To %TestCount
        If SarrSortSearch(arr, a(i)) = 0 Then
            ? "sort search fail" : Exit For
        End If
    Next i
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS ""
    SS "Sub SarrFastDelete(ByRef container As String, ByVal index As Long)"
    SS "    fast delete value at one-based index "
    SS "    fast on massive array but destroys array order"
    SS "    traverse back to front to use"
    SS "        fast delete "+Format$(SarrCount(arr), "#,")+" values"
    For i = SarrCount(arr) To 1 Step -1
        SarrFastDelete arr, i
    Next i
    SS "Time = " + Format$(Timer - d, "000.000")

    d = Timer
    For i = 1 To %TestCount
        a(i) = Repeat$(%LongString, "X")
    Next i

    SS ""
    SS ""
    SS "add "+Format$(%TestCount, "#,")+" strings "+Format$(%LongString, "#,")+" characters long"
    SarrClear arr
    d = Timer
    For i = 1 To %TestCount
        SarrAdd arr, a(i)
    Next i
    SS "Time = " + Format$(Timer - d, "000.000")


    SS ""
    SS "container size = " + Format$(Len(arr), "#,") + " bytes"
    SS "pack container"
    d = Timer
    SarrPack arr
    SS "Time = " + Format$(Timer - d, "000.000")
    SS "container size = " + Format$(Len(arr), "#,") + " bytes"

    SS ""
    SS "--- The End ---"
    SS ""

    Control Set Text gDlg, %TextBox, SBdrGet(stringBuilder)
End Sub

Function PBMain()
    Dialog Default Font "consolas", 12, 0, 0
    Dialog New 0, "Sample Code", 0, 0, 0, 0, %WS_Caption Or %WS_ClipSiblings Or %WS_MinimizeBox Or %WS_SysMenu Or %WS_ThickFrame, %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
    Dialog Show Modal gDlg, Call DlgCB
End Function
CallBack Function DlgCB()
    Select Case As Long Cb.Msg
        Case %WM_InitDialog
            WM_InitDialog()
        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_InitDialog()
    Local clientW, clientH As Long
    Desktop Get Client To clientW, clientH
    clientW /= 6
    clientH /= 5
    Dialog Set Loc gDlg, clientW / 2, clientH / 2
    Dialog Set Size gDlg, clientW, clientH
End Sub

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 = 2 : 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

#If Not %Def(%SBdr230824)
    %SBdr230824 = 1
    'String Builder Container
    %SBdrBufferMin = 1000
    %SBdrBufferMax = 5000000
    %SBdrExtra = 20
    Sub SBdrAdd(container$, value$)
        'append string
        Local lenValue&, lenContainer&, usedChars&, unusedChars&, buffer&
        lenValue& = Len(value$)
        lenContainer& = Len(container$)
        If lenValue& Then
            If lenContainer& = 0 Then
                usedChars& = lenValue&
                buffer& = %SBdrBufferMin
                container$ = Mkl$(usedChars&) + value$ + Nul$(buffer&)
            Else
                usedChars& = Cvl(container$)
                unusedChars& = lenContainer& - (usedChars&) - 4
                If lenValue& > unusedChars& - usedChars& Then
                    buffer& = usedChars& * %SBdrExtra
                    If buffer& < %SBdrBufferMin Then buffer& = %SBdrBufferMin
                    If buffer& > %SBdrBufferMax Then buffer& = %SBdrBufferMax
                    container$ += Nul$(buffer&)
                End If
                Poke$ StrPtr(container$) + 4 + usedChars&, value$
                Poke Long, StrPtr(container$), usedChars& + lenValue&
            End If
        End If
    End Sub
    Sub SBdrAddLine(container$, value$)
        'append string + $CrLf
        SBdrAdd container$, value$ + $CrLf
    End Sub
    Function SBdrGet(container$) As String
        'get complete string
        If Len(container$) > 4 Then Function = Peek$(StrPtr(container$) + 4, Cvl(container$))
    End Function
#EndIf '%SBdr230824�

Code Select
'Sash.bas
'Hash Table Sample
#Option LargeMem32
#Dim All
#Compile Exe
#Include Once "WIN32API.INC"

#Include Once "..\Sarr.inc"

%TextBox = 101
%BtnID = 102
Global gDlg As Long
Macro SS = SBdrAddLine stringBuilder,

Macro TestCount = 10000

Sub SampleCode()
    Register x As Long
    Local stringBuilder As String
    Local hash As String
    Local a() As String
    Local d As Double

    Randomize
    ReDim a(1 To TestCount)
    For x = 1 To TestCount
        a(x) = Format$(Rnd(-22222222, 222222222))
    Next x

    SS ""
    SS "Sub SashSetMetadata((ByRef container As String, ByVal value As String)"
    SS "    there is SarrMetadataSpace in each container for metadata"
    SS "    set metadata"
    SashSetMetadata hash, "My hash table ..........................................."

    SS ""
    SS "Function SashGetMetadata(ByRef container As String) As String"
    SS "    there is SarrMetadataSpace in each container for metadata"
    SS "    get metadata"
    SS "metadata = " + $Dq + SashGetMetadata(hash) + $Dq

    SS ""
    SS "Sub SashSet(ByRef container As String, ByVal key As String, ByVal value As String)"
    SS "    add key and associated value : value replaced if key exist"
    SS "        add few items"
    SashSet hash, "Key A", "Value A"
    SashSet hash, "Key B", "Value B"
    SashSet hash, "Key C", "Value C"
    SashSet hash, "Key D", "Value D"
    SashSet hash, "Key E", "Value E"
    SS "--- Display Hash Table ---"
    For x = 1 To SashCount(hash)
        SS "key = " + $Dq + SashGetKey(hash, x) + $Dq + ", value = " + $Dq + SashGetValue(hash, x) + $Dq
    Next x

    SS ""
    SS "change value for key 'Key C' "
    SashSet hash, "Key C", "Value for 'Key C' changed."
    SS "--- Display Hash Table ---"
    For x = 1 To SashCount(hash)
        SS "key = " + $Dq + SashGetKey(hash, x) + $Dq + ", value = " + $Dq + SashGetValue(hash, x) + $Dq
    Next x

    SS ""
    SS "Function SashGet(ByRef container As String, ByVal key As String) As String"
    SS "    get key's associated value"
    SS "value for 'Key C' = " + $Dq + SashGet(hash, "Key C") + $Dq
    SS "value for 'Key E' = " + $Dq + SashGet(hash, "Key E") + $Dq
    SS "value for 'Key ZZZ' = " + $Dq + SashGet(hash, "Key ZZZ") + $Dq

    SS ""
    SS "Function SashContains(ByRef container As String, ByVal key As String) As Long"
    SS "    return zero if key not in table"
    SS "hash contains 'Key B' = " + Format$(SashContains(hash, "Key B"))
    SS "hash contains 'Key D' = " + Format$(SashContains(hash, "Key D"))
    SS "hash contains 'Key ZZZ' = " + Format$(SashContains(hash, "Key ZZZ"))

    SS ""
    SS "Sub SashDelete(ByRef container As String, ByVal key As String)"
    SS "    delete key and associated value"
    SS "        delete key 'Key C' "
    SashDelete hash, "Key C"
    For x = 1 To SashCount(hash)
        SS "key = " + $Dq + SashGetKey(hash, x) + $Dq + ", value = " + $Dq + SashGetValue(hash, x) + $Dq
    Next x

    SS ""
    SS ""
    SashClear hash
    SS "add "+Format$(TestCount, "#,")+" random key/values to hash table"
    d = Timer
    For x = 1 To TestCount
        SashSet hash, a(x), a(x)
    Next x
    SS "Time = " + Format$(Timer - d, "000.000")
    SS "Hash Count = " + Format$(SashCount(hash), "#,") + " ... duplicate keys not allowed "

    SS ""
    SS "find "+Format$(TestCount, "#,")+" keys "
    d = Timer
    For x = 1 To TestCount
        If IsFalse SashContains(hash, a(x)) Then
            ? "SashContains() fail" : Exit For
        End If
    Next x
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS "Sub SashPack(ByRef container As String)"
    SS "    get rid of dead space"
    SS "size of container = " + Format$(Len(hash), "#,")
    SS "pack"
    d = Timer
    SashPack hash
    SS "size of container = " + Format$(Len(hash), "#,")
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS "get "+Format$(TestCount, "#,")+" values using key "
    d = Timer
    For x = 1 To TestCount
        If SashGet(hash, a(x)) <> a(x) Then
            ? "SashGet() fail" : Exit For
        End If
    Next x
    SS "Time = " + Format$(Timer - d, "000.000")

    SS ""
    SS ""

    Control Set Text gDlg, %TextBox, SBdrGet(stringBuilder)
    stringBuilder = ""
End Sub

Function PBMain()
    Dialog Default Font "consolas", 12, 0, 0
    Dialog New 0, "Sample Code", 0, 0, 0, 0, %WS_Caption Or %WS_ClipSiblings Or %WS_MinimizeBox Or %WS_SysMenu Or %WS_ThickFrame, %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
    Dialog Show Modal gDlg, Call DlgCB
End Function
CallBack Function DlgCB()
    Select Case As Long Cb.Msg
        Case %WM_InitDialog
            WM_InitDialog()
        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_InitDialog()
    Local clientW, clientH As Long
    Desktop Get Client To clientW, clientH
    clientW /= 6
    clientH /= 5
    Dialog Set Loc gDlg, clientW / 2, clientH / 2
    Dialog Set Size gDlg, clientW, clientH
End Sub

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 = 2 : 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

#If Not %Def(%SBdr230824)
    %SBdr230824 = 1
    'String Builder Container
    %SBdrBufferMin = 1000
    %SBdrBufferMax = 5000000
    %SBdrExtra = 20
    Sub SBdrAdd(container$, value$)
        'append string
        Local lenValue&, lenContainer&, usedChars&, unusedChars&, buffer&
        lenValue& = Len(value$)
        lenContainer& = Len(container$)
        If lenValue& Then
            If lenContainer& = 0 Then
                usedChars& = lenValue&
                buffer& = %SBdrBufferMin
                container$ = Mkl$(usedChars&) + value$ + Nul$(buffer&)
            Else
                usedChars& = Cvl(container$)
                unusedChars& = lenContainer& - (usedChars&) - 4
                If lenValue& > unusedChars& - usedChars& Then
                    buffer& = usedChars& * %SBdrExtra
                    If buffer& < %SBdrBufferMin Then buffer& = %SBdrBufferMin
                    If buffer& > %SBdrBufferMax Then buffer& = %SBdrBufferMax
                    container$ += Nul$(buffer&)
                End If
                Poke$ StrPtr(container$) + 4 + usedChars&, value$
                Poke Long, StrPtr(container$), usedChars& + lenValue&
            End If
        End If
    End Sub
    Sub SBdrAddLine(container$, value$)
        'append string + $CrLf
        SBdrAdd container$, value$ + $CrLf
    End Sub
    Function SBdrGet(container$) As String
        'get complete string
        If Len(container$) > 4 Then Function = Peek$(StrPtr(container$) + 4, Cvl(container$))
    End Function
#EndIf '%SBdr230824�


Code Select
'Table.bas
'Table Sample
#Option LargeMem32
#Dim All
#Compile Exe
#Include Once "WIN32API.INC"

#Include Once "..\Sarr.inc"

%TextBox = 101
%BtnID = 102
Global gDlg As Long
Macro SS = SBdrAddLine stringBuilder,

Function CompareColumn1(ByRef RowA As String, ByRef RowB As String) As Long
    Local ColA, ColB As String
    ColA = UCase$(SarrGet(RowA, 1))
    ColB = UCase$(SarrGet(RowB, 1))
    Function = Switch&(ColA < ColB, -1, ColA > ColB, 1) 'else match
End Function
Function CompareColumn2(ByRef RowA As String, ByRef RowB As String) As Long
    Local ColA, ColB As Long
    ColA = Cvl(SarrGet(RowA, 2))
    ColB = Cvl(SarrGet(RowB, 2))
    Function = Switch&(ColA < ColB, -1, ColA > ColB, 1) 'else match
End Function
Function CompareColumn3(ByRef RowA As String, ByRef RowB As String) As Long
    Local ColA, ColB As Ext
    ColA = Cve(SarrGet(RowA, 3))
    ColB = Cve(SarrGet(RowB, 3))
    Function = Switch&(ColA < ColB, -1, ColA > ColB, 1) 'else match
End Function

Sub SampleCode()
    Register x As Long
    Local stringBuilder As String
    Local Table, TableRow As String
    Local c2, c3 As Long

    'column 1 = String
    'column 2 = Long
    'column 3 = Extended

    Randomize

    SS ""
    SS "add rows"
    For x = 5 To 1 Step -1
        SarrReDim TableRow, 3
        SarrSet TableRow, 1, "Column" + Format$(x)
        SarrSet TableRow, 2,  Mkl$(Rnd(-1000, 1000))
        SarrSet TableRow, 3, Mke$(Rnd(-1000, 1000) / 3)
        SarrAdd Table, TableRow
    Next x
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS "sort on column 1"
    SS "    set compare callback"
    SarrComparison Table, CodePtr(CompareColumn1)
    SarrSort Table
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS "sort on column 2"
    SS "    set compare callback"
    SarrComparison Table, CodePtr(CompareColumn2)
    SarrSort Table
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS "sort on column 3"
    SS "    set compare callback"
    SarrComparison Table, CodePtr(CompareColumn3)
    SarrSort Table
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS "set column 2 = 1111 where column 1 = 'Column3' "
    SS "    array must be sorted on column searched"
    SS "    change compare callback"
    SarrComparison Table, CodePtr(CompareColumn1)
    SS "    sort"
    SarrSort Table
    SarrReDim TableRow, 3
    SarrSet TableRow, 1, "Column3"
    x = SarrSortSearch(Table, TableRow)
    If x Then
        TableRow = SarrGet(Table, x)
        SarrSet TableRow, 2, Mkl$(1111)
        SarrSet Table, x, TableRow
    End If
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS "SarrSortInsert() "
    SS "    may be used to insert new row at sort position, based on current callback"
    SarrReDim TableRow, 3
    SarrSet TableRow, 1, "Column333"
    SarrSet TableRow, 2,  Mkl$(Rnd(-1000, 1000))
    SarrSet TableRow, 3, Mke$(Rnd(-1000, 1000) / 3)
    SarrSortInsert Table, TableRow
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS "SarrSortDelete() "
    SS "    may be used to delete item maintaining sort order, based on current callback"
    SS "        delete where column 1 = 'Column333' "
    SarrReDim TableRow, 3
    SarrSet TableRow, 1, "Column333"
    SarrSortDelete Table, TableRow
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS "you can move through table using index to Get/Set values"
    SS "    multiply column 2 by 100"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        c2 = Cvl(SarrGet(TableRow, 2))
        c2 *= 100
        SarrSet TableRow, 2, Mkl$(c2)
        SarrSet Table, x, TableRow
    Next x
    SS "--- Display Table ---"
    For x = 1 To SarrCount(Table)
        TableRow = SarrGet(Table, x)
        SS SarrGet(TableRow, 1) +", "+ Format$(Cvl(SarrGet(TableRow, 2))) +", "+ Format$(Cve(SarrGet(TableRow, 3)))
    Next x

    SS ""
    SS ""

    Control Set Text gDlg, %TextBox, SBdrGet(stringBuilder)
    stringBuilder = ""
End Sub

Function PBMain()
    Dialog Default Font "consolas", 12, 0, 0
    Dialog New 0, "Sample Code", 0, 0, 0, 0, %WS_Caption Or %WS_ClipSiblings Or %WS_MinimizeBox Or %WS_SysMenu Or %WS_ThickFrame, %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
    Dialog Show Modal gDlg, Call DlgCB
End Function
CallBack Function DlgCB()
    Select Case As Long Cb.Msg
        Case %WM_InitDialog
            WM_InitDialog()
        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_InitDialog()
    Local clientW, clientH As Long
    Desktop Get Client To clientW, clientH
    clientW /= 6
    clientH /= 5
    Dialog Set Loc gDlg, clientW / 2, clientH / 2
    Dialog Set Size gDlg, clientW, clientH
End Sub

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 = 2 : 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

#If Not %Def(%SBdr230824)
    %SBdr230824 = 1
    'String Builder Container
    %SBdrBufferMin = 1000
    %SBdrBufferMax = 5000000
    %SBdrExtra = 20
    Sub SBdrAdd(container$, value$)
        'append string
        Local lenValue&, lenContainer&, usedChars&, unusedChars&, buffer&
        lenValue& = Len(value$)
        lenContainer& = Len(container$)
        If lenValue& Then
            If lenContainer& = 0 Then
                usedChars& = lenValue&
                buffer& = %SBdrBufferMin
                container$ = Mkl$(usedChars&) + value$ + Nul$(buffer&)
            Else
                usedChars& = Cvl(container$)
                unusedChars& = lenContainer& - (usedChars&) - 4
                If lenValue& > unusedChars& - usedChars& Then
                    buffer& = usedChars& * %SBdrExtra
                    If buffer& < %SBdrBufferMin Then buffer& = %SBdrBufferMin
                    If buffer& > %SBdrBufferMax Then buffer& = %SBdrBufferMax
                    container$ += Nul$(buffer&)
                End If
                Poke$ StrPtr(container$) + 4 + usedChars&, value$
                Poke Long, StrPtr(container$), usedChars& + lenValue&
            End If
        End If
    End Sub
    Sub SBdrAddLine(container$, value$)
        'append string + $CrLf
        SBdrAdd container$, value$ + $CrLf
    End Sub
    Function SBdrGet(container$) As String
        'get complete string
        If Len(container$) > 4 Then Function = Peek$(StrPtr(container$) + 4, Cvl(container$))
    End Function
#EndIf '%SBdr230824�


Code Select
'Sarr.inc
'Public domain, use at own risk. SDurham

    'In-String: String Array, String Hash Table, Unique Ordered String Set

    'In-String String Array

    'SarrComparison() set or change compare callback : default case sensitive
    'SarrSetMetadata() set metadata : each container can have a metadata string
    'SarrGetMetadata() get metadata
    'SarrCount() get item count
    'SarrClear() empty container
    'SarrReDim() only needed to set a specified number of items : space management automatic
    'SarrPack() get rid of dead space
    'SarrAdd() append value
    'SarrGet() get value at one-based index
    'SarrSet() set value at one-based index
    'SarrInsert() insert value at one-based index
    'SarrDelete() delete value at one-based index
    'SarrFastDelete() fast on massive array but destroys array order
    'SarrSort() quick sort
    'SarrSortSearch() binary search : optionally first or last
    'SarrSortInsert() binary insert : optionally ignore duplicates
    'SarrSortDelete() binary search and delete if found
    'SarrSortCount() get item count in sorted array
    'SarrReverse() reverse array
    'SarrPushFirst() insert value at front
    'SarrPushLast() append value to end
    'SarrPopFirst() get and remove first value
    'SarrPopLast() get and remove last value
    'SarrSplit() split array on delimited string
    'SarrJoin() join array to delimited string
    'SarrToTextFile() store array as text file
    'SarrFromTextFile() load text file
    'SarrFolders() get all folders in specified folder
    'SarrFiles() get all files in folder matching mask
    'SarrAllFolders() get all folders in specified folder and sub-folders
    'SarrAllFiles() get all files in specified folder, and sub-folders, matching mask

    'In-String Hash Table

    'SashComparison() set compare callback : default case sensitive
    'SashSetMetadata() set metadata : each container can have a metadata string
    'SashGetMetadata() get metadata
    'SashCount() get item count
    'SashClear() empty container
    'SashPack() get rid of dead space
    'SashSet() add key and associated value : value replaced if key exist
    'SashGet() get key's associated value
    'SashContains() return zero if key not in table
    'SashDelete() delete key and associated value
    'SashGetKey() get key at one-based index
    'SashGetValue() get value at one-based index

    'Unique Ordered String Set

    'SSetSetMetadata()set metadata : each container can have a metadata string
    'SSetGetMetadata() get metadata
    'SSetCount() get Set count
    'SSetClear() empty Set
    'SSetPack() get rid of dead space
    'SSetGet() get value in Set at one-based index
    'SSetAdd() add value to Set : duplicates ignored
    'SSetSubtract() remove value from set
    'SSetContains() true/false if value in Set
    'SSetAddSet() add one Set to other : duplicates ignored
    'SSetSubtractSet() subtract one Set from other
    'SSetContainsSet() true/false if one Set is a subset of other
    'SSetContained() get number of items in one Set that are in other
    'SSetNotContained() get number of items in one Set that aren't in other
    'SSetEqual() true if Sets equal
    'SSetSum() get unique Set of values in two other Sets
    'SSetDifference() get the difference between two Sets
    'SSetCommon() get Set of values common to two Sets
    'SSetUncommon() get Set of values uncommon to two Sets
    'SSetCommonCount() get number of items common to two Sets
    'SSetUncommonCount() get number of items uncommon to two Sets


    'In-String String Array Performance

    'add 10,000 values to empty array = 0.000 seconds
    'get 10,000 values = 0.016 seconds
    'binary search array for 10,000 values = 0.031 seconds
    'add 10,000 strings 500 characters long = 0.141 seconds
    'add 10,000 strings 1,000 characters long = 0.486 seconds
    'fast delete 10,000 values = 0.031 seconds

    'add 100,000 values to empty array = 0.047 seconds
    'get 100,000 values = 0.015 seconds
    'sort array of 100,000 random values = 0.490 seconds
    'binary search array for 100,000 values = 0.352 seconds
    'add 100,000 strings 100 characters long = 0.360 seconds
    'add 100,000 strings 500 characters long = 9.780 seconds
    'fast delete 100,000 values = 0.409 seconds

    'add 1,000,000 values to empty array = 1.489
    'get 1,000,000 values = 0.189
    'sort array of 1,000,000 random values = 6.442 seconds
    'binary search array for 1,000,000 values = 5.315 seconds
    'add 1,000,000 strings 100 characters long = 50.119 seconds
    'fast delete 1,000,000 values = 5.470 seconds

    'add 100 strings 1,000,000 characters long = 1.883 seconds


    'In-String Hash Table Performance

    'add 10,000 random key/values to hash table = 0.267 seconds
    'find 10,000 keys = 0.078 seconds
    'get 10,000 values using key = 0.078 seconds

    'add 20,000 random key/values to hash table = 0.723 seconds
    'find 20,000 keys = 0.159
    'get 20,000 values using key = 0.174 seconds

    'add 30,000 random key/values to hash table = 1.271 seconds
    'find 30,000 keys = 0.251 seconds
    'get 30,000 values using key = 0.266 seconds

    'add 40,000 random key/values to hash table = 1.888 seconds
    'find 40,000 keys = 0.345 seconds
    'get 40,000 values using key = 0.377 seconds

    'add 50,000 random key/values to hash table = 2.676 seconds
    'find 50,000 keys = 0.447 seconds
    'get 50,000 values using key = 0.475 seconds

    'add 60,000 random key/values to hash table = 3.531 seconds
    'find 60,000 keys = 0.615 seconds
    'get 60,000 values using key = 0.612

    'add 70,000 random key/values to hash table = 4.673 seconds
    'find 70,000 keys = 0.659 seconds
    'get 70,000 values using key = 0.675 seconds

    'add 80,000 random key/values to hash table = 5.690 seconds
    'find 80,000 keys = 0.786 seconds
    'get 80,000 values using key = 0.800

    'add 90,000 random key/values to hash table = 6.893 seconds
    'find 90,000 keys = 0.899 seconds
    'get 90,000 values using key = 0.942 seconds

    'add 100,000 random key/values to hash table = 8.224 seconds
    'find 100,000 keys = 1.020 seconds
    'get 100,000 values using key = 0.991 seconds

#IF NOT %DEF(%Sarr230829)
    %Sarr230829 = 1
    'InString String Array
    'Container protected with hash tag.

    DECLARE FUNCTION SarrCompare(BYREF a AS STRING, BYREF b AS STRING) AS LONG
        'compare callback template
        'a < b : return < 0
        'a = b : return = 0
        'a > b : return > 0
    MACRO SarrTag = 1783209428
    MACRO SarrMetadataSpace = 20
    MACRO SarrHeaderSize = (5 * 4) + SarrMetadataSpace + 1
    MACRO SarrRecordSize = 8
    MACRO SarrRecordBufferMax = 10000
    MACRO SarrRecordBufferMin = 4
    MACRO SarrCharacterBufferMax = 40000
    MACRO SarrCharacterBufferMin = 40
    MACRO SarrRecordMultiplier = 2
    MACRO SarrCharacterMultiplier = 5
    '   12345678901234567890123456789012345678901234567890  string position
    '                1234567890123456789012345678901234567  position in string space
    '   :header:array:used string space:free string space:
    '   56789012345678901234567890123456789012345678901234  string pointer position
    '   : left side  : right side                        :
    '   : metadata   : character space                   :
    TYPE SarrHeaderT
        tag AS LONG
        count AS LONG
        max AS LONG
        used AS LONG
        compare AS LONG
        metadata AS STRING * SarrMetadataSpace
    END TYPE
    TYPE SarrRecordT
        charSpaceOffset AS LONG
        bytes AS LONG
    END TYPE
    #IF NOT %DEF(%Unicode)
        %Unicode = 1
    #ENDIF '%Unicode
    '-------------------------------------
    '-------------------------------------
    '   String Array
    '-------------------------------------
    '-------------------------------------
    SUB SarrComparison(BYREF container AS STRING, BYVAL compareCB AS LONG)

        'change compare callback which changes sort and binary search order
        'default = case sensitive : CodePtr(SarrCompare)
        'CodePtr(SarrCompare) = case sensitive
        'CodePtr(SarrCompareUCase) = ignore case
        'CodePtr(procedure) for custom comparison

        IF LEN(container) = 0 THEN SarrInitialize(container)
        IF CVL(container) <> SarrTag THEN EXIT SUB
        IF compareCB THEN SarrSetCompare container, compareCB
    END SUB
    '-------------------------------------
    SUB SarrSetMetadata((BYREF container AS STRING, BYVAL value AS STRING)

        LOCAL p AS SarrHeaderT PTR

        'there is SarrMetadataSpace in each container for metadata
        'set metadata

        IF LEN(container) = 0 THEN SarrInitialize(container)
        IF CVL(container) <> SarrTag THEN EXIT SUB

        p = STRPTR(container)
        @p.metadata = value
    END SUB
    '-------------------------------------
    FUNCTION SarrGetMetadata(BYREF container AS STRING) AS STRING

        LOCAL p AS SarrHeaderT PTR

        'there is SarrMetadataSpace in each container for metadata
        'get metadata

        IF CVL(container) <> SarrTag THEN EXIT FUNCTION

        p = STRPTR(container)
        FUNCTION = TRIM$(@p.metadata)
    END FUNCTION
    '-------------------------------------
    FUNCTION SarrCount(BYREF container AS STRING) AS LONG

        'get item count

        IF LEN(container) AND CVL(container) = SarrTag THEN FUNCTION = SarrGetCount(container)
    END FUNCTION
    '-------------------------------------
    SUB SarrClear(BYREF container AS STRING)

        'empty container

        LOCAL compareCB AS LONG
        LOCAL metadata AS STRING

        IF LEN(container) THEN
            IF CVL(container) <> SarrTag THEN EXIT SUB
            compareCB = SarrGetCompare(container)
            metadata = SarrGetMetadata(container)
            container = ""
            SarrInitialize(container)
            SarrSetCompare container, compareCB
            SarrSetMetadata container, metadata
        END IF
    END SUB
    '-------------------------------------
    SUB SarrReDim(BYREF container AS STRING, BYVAL items AS LONG)

        'redimension array : data preserved
        'doesn't need be called, array is buffered
        'use to set a specified number of items

        IF LEN(container) = 0 THEN SarrInitialize(container)
        IF CVL(container) <> SarrTag THEN EXIT SUB

        IF items >= 0 THEN
            WHILE SarrGetCount(container) < items
                SarrPushLast container, ""
            WEND
            WHILE SarrGetCount(container) > items
                SarrPopLast(container)
            WEND
        END IF
    END SUB
    '-------------------------------------
    SUB SarrPack(BYREF container AS STRING)

        'get rid of dead space

        REGISTER i AS LONG
        LOCAL items, usedCharacters AS LONG
        LOCAL leftSide, rightSide AS STRING
        LOCAL a() AS STRING

        IF CVL(container) <> SarrTag THEN EXIT SUB

        items = SarrGetCount(container)
        usedCharacters = SarrGetUsed(container)
        IF items = 0 THEN
            SarrClear(container)
        ELSE
            REDIM a(1 TO items)
            FOR i = 1 TO items
                a(i) = SarrGet(container, i)
            NEXT x
            SarrClear container
            FOR i = 1 TO items
                SarrAdd container, a(i)
            NEXT x
            ERASE a()
            leftSide = LEFT$(container, SarrHeaderSize + (items * SarrRecordSize))
            rightSide = RIGHT$(container, SarrRight(container))
            rightSide = LEFT$(rightSide, usedCharacters)
            container = leftSide + rightSide
            SarrSetMax container, items
        END IF
    END SUB
    '-------------------------------------
    SUB SarrAdd(BYREF container AS STRING, BYVAL value AS STRING)

        'append value

        LOCAL bytes, charSpaceOffset, mem AS LONG
        LOCAL rec() AS SarrRecordT

        'get needed character space
        bytes = LEN(value)

        IF LEN(container) = 0 THEN SarrInitialize(container)
        IF CVL(container) <> SarrTag THEN EXIT SUB

        'add more records if needed
        IF SarrGetCount(container) = SarrGetMax(container) THEN SarrMoreRecords(container)

        'add more character space if needed
        IF SarrUnusedCharacters(container) < bytes THEN SarrMoreCharacters(container, bytes)

        'store value
        charSpaceOffset = SarrGetUsed(container)
        SarrSetUsed container, charSpaceOffset + bytes
        mem = STRPTR(container) + SarrLeft(container) + charSpaceOffset
        MEMORY COPY STRPTR(value), mem, bytes

        SarrSetCount container, SarrGetCount(container) + 1
        REDIM rec(1 TO SarrGetMax(container)) AT SarrArrMem(container)
        rec(SarrGetCount(container)).charSpaceOffset = charSpaceOffset
        rec(SarrGetCount(container)).bytes = bytes
    END SUB
    '-------------------------------------
    FUNCTION SarrGet(BYREF container AS STRING, BYVAL index AS LONG) AS STRING

        'get value at one-based index

        LOCAL mem, charSpaceOffset, bytes AS LONG
        LOCAL rec() AS SarrRecordT

        IF CVL(container) <> SarrTag THEN EXIT FUNCTION
        IF index < 1 OR index > SarrGetCount(container) THEN EXIT FUNCTION

        REDIM rec(1 TO SarrGetMax(container)) AT SarrArrMem(container)
        charSpaceOffset = rec(index).charSpaceOffset
        bytes = rec(index).bytes
        mem = STRPTR(container) + SarrLeft(container) + charSpaceOffset
        FUNCTION = PEEK$(mem, bytes)
    END FUNCTION
    '-------------------------------------
    SUB SarrSet(BYREF container AS STRING, BYVAL index AS LONG, BYVAL value AS STRING)

        'set value at one-based index

        LOCAL mem, charSpaceOffset, bytes AS LONG
        LOCAL rec() AS SarrRecordT

        IF CVL(container) <> SarrTag THEN EXIT SUB
        IF index < 1 OR index > SarrGetCount(container) THEN EXIT SUB

        'get needed character space
        bytes = LEN(value)

        'replace string
        REDIM rec(1 TO SarrGetMax(container)) AT SarrArrMem(container)
        IF bytes > rec(index).bytes THEN
            'abandon old string space

            'add more character space if needed
            IF SarrUnusedCharacters(container) < bytes THEN SarrMoreCharacters(container, bytes)

            'store value in new space
            charSpaceOffset = SarrGetUsed(container)
            SarrSetUsed container, charSpaceOffset + bytes
            mem = STRPTR(container) + SarrLeft(container) + charSpaceOffset
            MEMORY COPY STRPTR(value), mem, bytes

            REDIM rec(1 TO SarrGetMax(container)) AT SarrArrMem(container)
            rec(index).charSpaceOffset = charSpaceOffset
            rec(index).bytes = bytes
        ELSE
            'we have enough space

            rec(index).bytes = bytes
            charSpaceOffset = rec(index).charSpaceOffset
            mem = STRPTR(container) + SarrLeft(container) + charSpaceOffset
            MEMORY COPY STRPTR(value), mem, bytes
        END IF
    END SUB
    '-------------------------------------
    SUB SarrInsert(BYREF container AS STRING, BYVAL index AS LONG, BYVAL value AS STRING)

        'insert value at one-based index

        LOCAL charSpaceOffset, mem, bytes AS LONG
        LOCAL qud() AS QUAD
        LOCAL rec() AS SarrRecordT

        IF CVL(container) <> SarrTag THEN EXIT SUB
        IF index < 1 OR index > SarrGetCount(container) THEN EXIT SUB

        'get needed character space
        bytes = LEN(value)

        'add more records if needed : we need two more
        IF SarrGetMax(container) = SarrGetCount(container) THEN SarrMoreRecords(container)

        'add more character space if needed
        IF SarrUnusedCharacters(container) < bytes THEN SarrMoreCharacters(container, bytes)

        'insert record space
        REDIM qud(1 TO SarrGetMax(container)) AT SarrArrMem(container)
        ARRAY INSERT qud(index), 0
        SarrSetCount container, SarrGetCount(container) + 1

        'store value
        charSpaceOffset = SarrGetUsed(container)
        SarrSetUsed container, charSpaceOffset + bytes
        mem = STRPTR(container) + SarrLeft(container) + charSpaceOffset
        MEMORY COPY STRPTR(value), mem, bytes

        REDIM rec(1 TO SarrGetMax(container)) AT SarrArrMem(container)
        rec(index).charSpaceOffset = charSpaceOffset
        rec(index).bytes = bytes
    END SUB
    '-------------------------------------
    SUB SarrDelete(BYREF container AS STRING, BYVAL index AS LONG)

        'delete value at one-based index

        LOCAL qud() AS QUAD

        IF CVL(container) <> SarrTag THEN EXIT SUB
        IF index < 1 OR index > SarrGetCount(container) THEN EXIT SUB

        REDIM qud(1 TO SarrGetCount(container)) AT SarrArrMem(container)
        ARRAY DELETE qud(index)
        SarrSetCount container, SarrGetCount(container) - 1
    END SUB
    '-------------------------------------
    SUB SarrFastDelete(BYREF container AS STRING, BYVAL index AS LONG)

        'fast delete value at one-based index
        'fast on massive array but destroys array order
        'traverse back to front to use

        LOCAL qud() AS QUAD

        IF CVL(container) <> SarrTag THEN EXIT SUB
        IF index < 1 OR index > SarrGetCount(container) THEN EXIT SUB

        REDIM qud(1 TO SarrGetCount(container)) AT SarrArrMem(container)
        IF index < SarrGetCount(container) THEN SWAP qud(index), qud(SarrGetCount(container))
        SarrSetCount container, SarrGetCount(container) - 1
    END SUB
    '-------------------------------------
    '-------------------------------------
    '   Sort Order
    '-------------------------------------
    '-------------------------------------
    SUB SarrSort(BYREF container AS STRING)

        'non-recursive quick sort

        REGISTER i AS LONG
        REGISTER j AS LONG
        LOCAL k, leftIndex, rightIndex, counter, compareCB, compare AS LONG
        LOCAL value AS STRING
        LOCAL qud() AS QUAD

        IF CVL(container) <> SarrTag THEN EXIT SUB

        compareCB = SarrGetCompare(container)
        leftIndex = 1
        rightIndex = SarrGetCount(container)
        IF rightIndex > 1 THEN
            REDIM qud(1 TO rightIndex) AT SarrArrMem(container)
            counter = 1
            !PUSH leftIndex
            !PUSH rightIndex
            WHILE counter
                DECR counter
                !POP rightIndex
                !POP leftIndex
                i = leftIndex
                j = rightIndex
                k = i + j
                SHIFT RIGHT k, 1
                value = SarrGet(container, k)
                WHILE i <= j
                    CALL DWORD compareCB USING SarrCompare(SarrGet(container, i), value) TO compare
                    WHILE compare < 0
                        INCR i
                        CALL DWORD compareCB USING SarrCompare(SarrGet(container, i), value) TO compare
                    WEND
                    CALL DWORD compareCB USING SarrCompare(SarrGet(container, j), value) TO compare
                    WHILE compare > 0
                        DECR j
                        CALL DWORD compareCB USING SarrCompare(SarrGet(container, j), value) TO compare
                    WEND
                    IF i <= j THEN
                        SWAP qud(i), qud(j) : INCR i : DECR j
                    END IF
                WEND
                IF leftIndex < j THEN
                    !PUSH leftIndex
                    !PUSH j
                    INCR counter
                END IF
                IF i < rightIndex THEN
                    !PUSH i
                    !PUSH rightIndex
                    INCR counter
                END IF
            WEND
        END IF
    END SUB
    '-------------------------------------
    FUNCTION SarrSortSearch(BYREF container AS STRING, BYVAL value AS STRING, OPT BYVAL findFirst AS LONG, OPT BYVAL findLast AS LONG) AS LONG

        'binary search for value : return index : zero if not found : array must be sorted
        'if IsTrue findFirst then first instance found
        'if IsTrue findLast then last instance found

        REGISTER i AS LONG
        REGISTER j AS LONG
        LOCAL bot, top, result, compareCB, compare AS LONG

        IF CVL(container) <> SarrTag THEN EXIT FUNCTION

        compareCB = SarrGetCompare(container)
        bot = 1
        top = SarrGetCount(container)
        IF top THEN
            WHILE top >= bot
                i = bot + top
                SHIFT RIGHT i, 1 'divide by 2
                CALL DWORD compareCB USING SarrCompare(value, SarrGet(container, i)) TO compare
                IF compare > 0 THEN
                    bot = i + 1
                ELSEIF compare < 0 THEN
                    top = i - 1
                ELSE
                    result = i
                    IF ISTRUE findFirst THEN
                        FOR j = i - 1 TO 1 STEP -1
                            CALL DWORD compareCB USING SarrCompare(value, SarrGet(container, j)) TO compare
                            IF compare = 0 THEN
                                result = j
                            ELSE
                                EXIT FOR
                            END IF
                        NEXT j
                    ELSEIF ISTRUE findLast THEN
                        FOR j = i + 1 TO SarrGetCount(container)
                            CALL DWORD compareCB USING SarrCompare(value, SarrGet(container, j)) TO compare
                            IF compare = 0 THEN
                                result = j
                            ELSE
                                EXIT FOR
                            END IF
                        NEXT j
                    END IF
                    FUNCTION = result
                    EXIT FUNCTION
                END IF
            WEND
        END IF
    END FUNCTION
    '-------------------------------------
    SUB SarrSortInsert(BYREF container AS STRING, BYVAL value AS STRING, OPT BYVAL unique AS LONG)

        'insert value at sort position : added if empty : array must be sorted or empty
        'if IsTrue unique then duplicates ignored

        REGISTER i AS LONG
        LOCAL bot, top, compareCB, compare AS LONG

        IF LEN(container) = 0 THEN SarrInitialize(container)
        IF CVL(container) <> SarrTag THEN EXIT SUB

        compareCB = SarrGetCompare(container)
        bot = 1
        top = SarrGetCount(container)
        IF top THEN
            WHILE top >= bot
                i = bot + top
                SHIFT RIGHT i, 1 'divide by 2
                CALL DWORD compareCB USING SarrCompare(value, SarrGet(container, i)) TO compare
                IF compare > 0 THEN
                    bot = i + 1
                ELSEIF compare < 0 THEN
                    top = i - 1
                ELSE
                    IF ISFALSE unique THEN SarrInsert(container, i, value)
                    EXIT SUB
                END IF
            WEND
            IF compare < 0 THEN
                SarrInsert(container, i, value)
            ELSEIF i < SarrGetCount(container) THEN
                SarrInsert(container, i + 1, value)
            ELSE
               SarrAdd(container, value)
            END IF
        ELSE
            SarrAdd(container, value)
        END IF
    END SUB
    '-------------------------------------
    SUB SarrSortDelete(BYREF container AS STRING, BYVAL value AS STRING)

        'delete one instance of value if in array maintaining sort order : array must be sorted

        LOCAL x AS LONG

        x = SarrSortSearch(container, value)
        IF x THEN SarrDelete container, x
    END SUB
    '-------------------------------------
    FUNCTION SarrSortCount(BYREF container AS STRING, BYVAL value AS STRING) AS LONG

        'get value's instance count : array must be sorted

        LOCAL first, last AS LONG

        first = SarrSortSearch(container, value, 1, 0)
        last = SarrSortSearch(container, value, 0, 1)
        FUNCTION = last - first + 1
    END FUNCTION
    '-------------------------------------
    SUB SarrReverse(BYREF container AS STRING)

        'reverse array

        REGISTER i AS LONG
        REGISTER j AS LONG
        LOCAL qud() AS QUAD

        IF CVL(container) <> SarrTag THEN EXIT SUB

        i = 1
        j = SarrGetCount(container)
        IF j > 1 THEN
            REDIM qud(1 TO SarrGetMax(container)) AT SarrArrMem(container)
            WHILE i < j
                SWAP qud(i), qud(j)
                INCR i
                DECR j
            WEND
        END IF
    END SUB
    '-------------------------------------
    '-------------------------------------
    '   Stack and Queue
    '-------------------------------------
    '-------------------------------------
    SUB SarrPushFirst(BYREF container AS STRING, BYVAL value AS STRING)

        'insert value at front

        IF SarrCount(container) THEN SarrInsert(container, 1, value) ELSE SarrAdd(container, value)
    END SUB
    '-------------------------------------
    SUB SarrPushLast(BYREF container AS STRING, BYVAL value AS STRING)

        'append value to end of array

        SarrAdd container, value
    END SUB
    '-------------------------------------
    FUNCTION SarrPopFirst(BYREF container AS STRING) AS STRING

        'get and remove first value in array

        IF SarrCount(container) THEN
            FUNCTION = SarrGet(container, 1)
            SarrDelete container, 1
        END IF
    END FUNCTION
    '-------------------------------------
    FUNCTION SarrPopLast(BYREF container AS STRING) AS STRING

        'get and remove first value in array

        LOCAL items AS LONG

        items = SarrCount(container)
        IF items THEN
            FUNCTION = SarrGet(container, items)
            SarrDelete container, items
        END IF
    END FUNCTION
    '-------------------------------------
    '-------------------------------------
    '   Split and Join
    '-------------------------------------
    '-------------------------------------
    SUB SarrSplit(BYREF container AS STRING, BYVAL delimitedString AS STRING, BYVAL delimiter AS STRING)

        'split array on delimited string

        REGISTER i AS LONG
        LOCAL items AS LONG
        LOCAL a() AS STRING

        IF CVL(container) <> SarrTag THEN EXIT SUB

        SarrClear container
        IF LEN(delimitedString) THEN
            items = PARSECOUNT(delimitedString, delimiter)
            IF items THEN
                REDIM a(1 TO items)
                PARSE delimitedString, a(), delimiter
                FOR i = 1 TO items
                    SarrAdd container, a(i)
                NEXT x
            END IF
        END IF
    END SUB
    '-------------------------------------
    FUNCTION SarrJoin(BYREF container AS STRING, BYVAL delimiter AS STRING) AS STRING

        'join array to delimited string

        REGISTER i AS LONG
        LOCAL items AS LONG
        LOCAL a() AS WSTRING

        IF CVL(container) <> SarrTag THEN EXIT FUNCTION

        items = SarrCount(container)
        IF items THEN
            REDIM a(1 TO items)
            FOR i = 1 TO items
                a(i) = UTF8TOCHR$(SarrGet(container, i))
            NEXT x
            FUNCTION = JOIN$(a(), delimiter)
        END IF
    END FUNCTION
    '-------------------------------------
    '-------------------------------------
    '   To/From Text File
    '-------------------------------------
    '-------------------------------------
    SUB SarrToTextFile(BYREF container AS STRING, BYVAL file AS WSTRING)

        'store array as text file

        StrToFile file, TRIM$(SarrJoin(container, $CRLF), $CRLF) + $CRLF
    END SUB
    '-------------------------------------
    SUB SarrFromTextFile(BYREF container AS STRING, BYVAL file AS WSTRING)

        'load text file

        SarrSplit container, TRIM$(StrFromFile(file), $CRLF), $CRLF
    END SUB
    '-------------------------------------
    '-------------------------------------
    '   File and Folder List
    '-------------------------------------
    '-------------------------------------
    SUB SarrFolders(BYREF container AS STRING, BYVAL specifiedFolder AS WSTRING)

        'get all folders in specified folder
        'items stored UTF8

        LOCAL folder, folderMask, specifiedPath AS WSTRING
        LOCAL DrD AS DIRDATA

        SarrClear container
        IF ISFALSE ISFOLDER(specifiedFolder) THEN EXIT SUB

        specifiedPath = RTRIM$(specifiedFolder, "\") + "\"
        folderMask = specifiedPath
        folder = DIR$(folderMask, ONLY %SUBDIR TO DrD)
        WHILE LEN(folder)
            SarrAdd container, CHRTOUTF8$(specifiedPath + folder)
            folder = DIR$
        WEND
    END SUB
    '-------------------------------------
    SUB SarrFiles(BYREF container AS STRING, BYVAL specifiedFolder AS WSTRING, BYVAL mask AS WSTRING)

        'get all files in folder matching mask
        'items stored UTF8

        LOCAL file, fileMask AS WSTRING

        SarrClear container
        IF ISFALSE ISFOLDER(specifiedFolder) THEN EXIT SUB

        specifiedFolder = RTRIM$(specifiedFolder, "\") + "\"
        fileMask = specifiedFolder + mask
        file = DIR$(fileMask)
        WHILE LEN(file)
            SarrAdd container, CHRTOUTF8$(specifiedFolder + file)
            file = DIR$
        WEND
    END SUB
    '-------------------------------------
    SUB SarrAllFolders(BYREF container AS STRING, BYVAL specifiedFolder AS WSTRING)

        'get all folders in specified folder and sub-folders
        'items stored UTF8

        LOCAL foldersArr, subFoldersArr AS STRING
        LOCAL currentFolder AS WSTRING

        SarrClear container
        IF ISFALSE ISFOLDER(specifiedFolder) THEN EXIT SUB

        SarrPushLast foldersArr, specifiedFolder
        WHILE SarrCount(foldersArr)
            currentFolder = SarrPopLast(foldersArr)
            SarrAdd container, currentFolder
            SarrFolders subFoldersArr, currentFolder
            WHILE SarrCount(subFoldersArr)
                SarrPushLast foldersArr, SarrPopLast(subFoldersArr)
            WEND
        WEND
    END SUB
    '-------------------------------------
    SUB SarrAllFiles(BYREF container AS STRING, BYVAL specifiedFolder AS WSTRING, BYVAL mask AS WSTRING)

        'get all files in specified folder, and sub-folders, matching mask
        'items stored UTF8

        LOCAL allFoldersArr, folderFilesArr AS STRING

        SarrClear container
        IF ISFALSE ISFOLDER(specifiedFolder) THEN EXIT SUB

        SarrAllFolders allFoldersArr, specifiedFolder
        WHILE SarrCount(allFoldersArr)
            SarrFiles folderFilesArr, SarrPopLast(allFoldersArr), mask
            WHILE SarrCount(folderFilesArr)
                SarrAdd container, SarrPopLast(folderFilesArr)
            WEND
        WEND
    END SUB
    '-------------------------------------
    '-------------------------------------
    '   PRIVATE
    '-------------------------------------
    '-------------------------------------
    SUB SarrSetTag(BYREF container AS STRING, BYVAL value AS LONG)  PRIVATE

        'set container header tag parameter

        IF LEN(container) THEN POKE LONG, STRPTR(container), value
    END SUB
    '-------------------------------------
    FUNCTION SarrGetCount(BYREF container AS STRING)  PRIVATE AS LONG

        'get container header count parameter

        IF LEN(container) THEN FUNCTION = PEEK(LONG, STRPTR(container) + 4)
    END FUNCTION
    '-------------------------------------
    SUB SarrSetCount(BYREF container AS STRING, BYVAL value AS LONG) PRIVATE

        'set container header count parameter

        IF LEN(container) THEN POKE LONG, STRPTR(container) + 4, value
    END SUB
    '-------------------------------------
    FUNCTION SarrGetMax(BYREF container AS STRING) PRIVATE AS LONG

        'get container header max parameter

        IF LEN(container) THEN FUNCTION = PEEK(LONG, STRPTR(container) + 8)
    END FUNCTION
    '-------------------------------------
    SUB SarrSetMax(BYREF container AS STRING, BYVAL value AS LONG) PRIVATE

        'set container header max parameter

        IF LEN(container) THEN POKE LONG, STRPTR(container) + 8, value
    END SUB
    '-------------------------------------
    FUNCTION SarrGetUsed(BYREF container AS STRING) PRIVATE AS LONG

        'get container header used parameter

        IF LEN(container) THEN FUNCTION = PEEK(LONG, STRPTR(container) + 12)
    END FUNCTION
    '-------------------------------------
    SUB SarrSetUsed(BYREF container AS STRING, BYVAL value AS LONG) PRIVATE

        'set container header used  parameter

        IF LEN(container) THEN POKE LONG, STRPTR(container) + 12, value
    END SUB
    '-------------------------------------
    FUNCTION SarrGetCompare(BYREF container AS STRING)  PRIVATE AS LONG

        'get container header compare parameter

        IF LEN(container) THEN FUNCTION = PEEK(LONG, STRPTR(container) + 16)
    END FUNCTION
    '-------------------------------------
    SUB SarrSetCompare(BYREF container AS STRING, BYVAL value AS LONG) PRIVATE

        'set container header compare  parameter

        IF LEN(container) THEN POKE LONG, STRPTR(container) + 16, value
    END SUB
    '-------------------------------------
    SUB SarrInitialize(BYREF container AS STRING) PRIVATE

        'initialize container : not necessary to call : automatic

        container = NUL$(SarrHeaderSize + (SarrRecordBufferMin * SarrRecordSize) + SarrCharacterBufferMin)
        SarrSetTag container, SarrTag
        SarrSetMax container, SarrRecordBufferMin
        SarrSetCompare container, CODEPTR(SarrCompare)
    END SUB
    '-------------------------------------
    FUNCTION SarrArrSize(BYREF container AS STRING) PRIVATE AS LONG

        'get size of record array

        FUNCTION = SarrGetMax(container) * SarrRecordSize
    END FUNCTION
    '-------------------------------------
    FUNCTION SarrArrMem(BYREF container AS STRING) PRIVATE AS LONG

        'get record array memory address

        FUNCTION = STRPTR(container) + SarrHeaderSize
    END FUNCTION
    '-------------------------------------
    FUNCTION SarrLeft(BYREF container AS STRING) PRIVATE AS LONG

        'get length of left side

        FUNCTION = SarrHeaderSize + SarrArrSize(container)
    END FUNCTION
    '-------------------------------------
    FUNCTION SarrRight(BYREF container AS STRING) PRIVATE AS LONG

        'get length of right side

        FUNCTION = LEN(container) - SarrLeft(container)
    END FUNCTION
    '-------------------------------------
    SUB SarrMoreRecords(BYREF container AS STRING) PRIVATE

        'add more record space

        LOCAL buffer AS LONG
        LOCAL leftSide, rightSide AS STRING

        buffer = SarrGetCount(container) * SarrRecordMultiplier
        IF buffer < SarrRecordBufferMin THEN buffer = SarrRecordBufferMin
        IF buffer > SarrRecordBufferMax THEN buffer = SarrRecordBufferMax
        rightSide = RIGHT$(container, SarrRight(container))
        leftSide = LEFT$(container, SarrLeft(container))
        leftSide += NUL$(buffer * SarrRecordSize)
        container = leftSide + rightSide
        SarrSetMax container, SarrGetMax(container) + buffer
    END SUB
    '-------------------------------------
    SUB SarrMoreCharacters(BYREF container AS STRING, BYVAL bytes AS LONG) PRIVATE

        'add more character space

        LOCAL buffer AS LONG
        LOCAL p AS SarrHeaderT PTR

        p = STRPTR(container)
        buffer = SarrGetCount(container) * SarrCharacterMultiplier
        IF buffer < SarrCharacterBufferMin THEN buffer = SarrCharacterBufferMin
        IF buffer > SarrCharacterBufferMax THEN buffer = SarrCharacterBufferMax
        container += NUL$(buffer + bytes)
    END SUB
    '-------------------------------------
    FUNCTION SarrUnusedCharacters(BYREF container AS STRING) PRIVATE AS LONG

        'get unused character space

        FUNCTION = LEN(container) - SarrLeft(container) - SarrGetUsed(container)
    END FUNCTION
    '-------------------------------------
    '-------------------------------------
    '   Callback Functions
    '-------------------------------------
    '-------------------------------------
    FUNCTION SarrCompare(BYREF a AS STRING, BYREF b AS STRING) PRIVATE AS LONG
        'case sensitive compare callback
        FUNCTION = SWITCH&(a < b, -1, a > b, 1) 'else match
    END FUNCTION
    '-------------------------------------
    FUNCTION SarrCompareUCase(BYREF a AS STRING, BYREF b AS STRING) PRIVATE AS LONG
        'upper case compare callback
        LOCAL ua AS STRING : ua = UCASE$(a)
        LOCAL ub AS STRING : ub = UCASE$(b)
        FUNCTION = SWITCH&(ua < ub, -1, ua > ub, 1) 'else match
    END FUNCTION
    '-------------------------------------
#ENDIF '%Sarr230829

#IF NOT %DEF(%Sash230903)
    %Sash230903 = 1
    'InString Hash Table
    'Value stored and retrieved using unique lookup key.
    'Keys are case sensitive.
    'Key and value can be any kind of binary data, nulls, MK_$,  ChrToUtf8$(), ...
    'Uses string array and binary search and insert.
    'Stays in key ordr.
    '-------------------------------------
    '-------------------------------------
    '   Hash Table
    '-------------------------------------
    '-------------------------------------
    '-------------------------------------
    SUB SashComparison(BYREF container AS STRING, BYVAL compareCB AS LONG)

        'this implementation stays in key order
        '!!! must be changed before use, will erase all data !!!
        'default is case sensitive : CodePtr(SashCompare)
        'set CodePtr(SashCompareUCase) to ignore case
        'set CodePtr(procedure) for custom comparison
        '   modify provided callbacks
        '   keep in mind that only unique keys are allowed

        IF LEN(container) = 0 THEN SarrInitialize(container)
        IF CVL(container) <> SarrTag THEN EXIT SUB

        SashClear container
        IF compareCB THEN SarrSetCompare container, compareCB
    END SUB
    '-------------------------------------
    SUB SashSetMetadata((BYREF container AS STRING, BYVAL value AS STRING)

        'there is SarrMetadataSpace in each container for metadata
        'set metadata

        SarrSetMetadata container, value
    END SUB
    '-------------------------------------
    FUNCTION SashGetMetadata(BYREF container AS STRING) AS STRING

        'there is SarrMetadataSpace in each container for metadata
        'get metadata

        FUNCTION = SarrGetMetadata(container)
    END FUNCTION
    '-------------------------------------
    FUNCTION SashCount(BYREF container AS STRING) AS LONG

        'get item count

        IF LEN(container) AND CVL(container) = SarrTag THEN FUNCTION = SarrGetCount(container)
    END FUNCTION
    '-------------------------------------
    SUB SashClear(BYREF container AS STRING)

        'empty container

        SarrClear container
    END SUB
    '-------------------------------------
    SUB SashPack(BYREF container AS STRING)

        'get rid of dead space

        LOCAL x AS LONG
        LOCAL KeyValArr AS STRING

        IF CVL(container) <> SarrTag THEN EXIT SUB

        FOR x = 1 TO SarrCount(container)
            KeyValArr = SarrGet(container, x)
            SarrPack KeyValArr
            SarrSet container, x, KeyValArr
        NEXT x
        SarrPack container
    END SUB
    '-------------------------------------
    SUB SashSet(BYREF container AS STRING, BYVAL key AS STRING, BYVAL value AS STRING)

        'add key and associated value : value replaced if key exist

        LOCAL x AS LONG
        LOCAL KeyValArr AS STRING

        SarrComparison container, CODEPTR(SashCompare)
        IF CVL(container) <> SarrTag THEN EXIT SUB

        SarrRedim KeyValArr, 2
        SarrSet KeyValArr, 1, key
        SarrSet KeyValArr, 2, value
        x = SarrSortSearch(container, KeyValArr)
        IF x THEN
            SarrSet container, x, KeyValArr
        ELSE
            SarrSortInsert container, KeyValArr
        END IF
    END SUB
    '-------------------------------------
    FUNCTION SashGet(BYREF container AS STRING, BYVAL key AS STRING) AS STRING

        'get key's associated value

        LOCAL x AS LONG
        LOCAL KeyValArr AS STRING

        x = SashContains(container, key)
        IF x THEN
            KeyValArr = SarrGet(container, x)
            FUNCTION = SarrGet(KeyValArr, 2)
        END IF
    END FUNCTION
    '-------------------------------------
    FUNCTION SashContains(BYREF container AS STRING, BYVAL key AS STRING) AS LONG

        'return zero if key not in table

        LOCAL x AS LONG
        LOCAL KeyValArr AS STRING

        IF CVL(container) <> SarrTag THEN EXIT FUNCTION

        SarrRedim KeyValArr, 2
        SarrSet KeyValArr, 1, key
        FUNCTION = SarrSortSearch(container, KeyValArr)
    END FUNCTION
    '-------------------------------------
    SUB SashDelete(BYREF container AS STRING, BYVAL key AS STRING)

        'delete key and associated value

        LOCAL KeyValArr AS STRING

        SarrRedim KeyValArr, 2
        SarrSet KeyValArr, 1, key
        SarrSortDelete container, KeyValArr
    END SUB
    '-------------------------------------
    FUNCTION SashGetKey(BYREF container AS STRING, BYVAL index AS LONG) AS STRING

        'get key at one-based index

        LOCAL KeyValArr AS STRING

        KeyValArr = SarrGet(container, index)
        IF LEN(KeyValArr) THEN FUNCTION = SarrGet(KeyValArr, 1)
    END FUNCTION
    '-------------------------------------
    FUNCTION SashGetValue(BYREF container AS STRING, BYVAL index AS LONG) AS STRING

        'get value at one-based index

        LOCAL KeyValArr AS STRING

        KeyValArr = SarrGet(container, index)
        IF LEN(KeyValArr) THEN FUNCTION = SarrGet(KeyValArr, 2)
    END FUNCTION
    '-------------------------------------
    '-------------------------------------
    '   PRIVATE
    '-------------------------------------
    '-------------------------------------
    FUNCTION SashCompare(BYREF a AS STRING, BYREF b AS STRING) PRIVATE AS LONG
        'case sensitive compare callback
        LOCAL keyA AS STRING : keyA = SarrGet(a, 1)
        LOCAL keyB AS STRING : keyB = SarrGet(b, 1)
        FUNCTION = SWITCH&(keyA < keyB, -1, keyA > keyB, 1) 'else match
    END FUNCTION
    FUNCTION SashCompareUCase(BYREF a AS STRING, BYREF b AS STRING) PRIVATE AS LONG
        'case sensitive compare callback
        LOCAL keyA AS STRING : keyA = UCASE$(SarrGet(a, 1))
        LOCAL keyB AS STRING : keyB = UCASE$(SarrGet(b, 1))
        FUNCTION = SWITCH&(keyA < keyB, -1, keyA > keyB, 1) 'else match
    END FUNCTION
#ENDIF '%Sash230903


#IF NOT %DEF(%SSet230905)
    %SSet230905 = 1
    'Each Set is a group of unique values.
    'Comparison is case sensitive.
    '-------------------------------------
    '-------------------------------------
    '   Unique Ordered String Set
    '-------------------------------------
    '-------------------------------------
    SUB SSetSetMetadata(BYREF ThisSet AS STRING, BYVAL value AS STRING)

        'there is SarrMetadataSpace in each container for metadata
        'set metadata

        SarrSetMetadata ThisSet, value
    END SUB
    '-------------------------------------
    FUNCTION SSetGetMetadata(BYREF ThisSet AS STRING) AS STRING

        'there is SarrMetadataSpace in each container for metadata
        'get metadata

        FUNCTION = SarrGetMetadata(ThisSet)
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetCount(BYREF ThisSet AS STRING) AS LONG

        'get unique items in ThisSet

        FUNCTION = SarrCount(ThisSet)
    END FUNCTION
    '-------------------------------------
    SUB SSetClear(BYREF ThisSet AS STRING)

        'empty ThisSet

        SarrClear ThisSet
    END SUB
    '-------------------------------------
    SUB SSetPack(BYREF ThisSet AS STRING)

        'get rid of dead space

        SarrPack ThisSet
    END SUB
    '-------------------------------------
    FUNCTION SSetGet(BYREF ThisSet AS STRING, BYVAL index AS LONG) AS STRING

        'get value in ThisSet at one-based index

        FUNCTION = SarrGet(ThisSet, index)
    END FUNCTION
    '-------------------------------------
    SUB SSetAdd(BYREF ThisSet AS STRING, BYVAL value AS STRING)

        'add value to ThisSet : ignored if duplicate

        SarrSortInsert ThisSet, value, 1
    END SUB
    '-------------------------------------
    SUB SSetSubtract(BYREF ThisSet AS STRING, BYVAL value AS STRING)

        'remove value if in ThisSet

        SarrSortDelete ThisSet, value
    END SUB
    '-------------------------------------
    FUNCTION SSetContains(BYREF ThisSet AS STRING, BYVAL value AS STRING) AS BYTE

        'true/false if value in ThisSet

        IF SarrSortSearch(ThisSet, value) THEN FUNCTION = 1
    END FUNCTION
    '-------------------------------------
    SUB SSetAddSet(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING)

        'add OtherSet to ThisSet : duplicates ignored

        REGISTER x AS LONG

        FOR x = 1 TO SSetCount(OtherSet)
            SSetAdd ThisSet, SSetGet(OtherSet, x)
        NEXT x
    END SUB
    '-------------------------------------
    SUB SSetSubtractSet(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING)

        'remove all values from ThisSet that are in OtherSet

        REGISTER x AS LONG

        FOR x = 1 TO SSetCount(OtherSet)
            SSetSubtract ThisSet, SSetGet(OtherSet, x)
        NEXT x
    END SUB
    '-------------------------------------
    FUNCTION SSetContainsSet(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS BYTE

        'true if neither Set empty and all values in OtherSet are in ThisSet

        REGISTER x AS LONG

        IF SSetCount(ThisSet) AND SSetCount(OtherSet) THEN
            FOR x = 1 TO SSetCount(OtherSet)
                IF ISFALSE SSetContains(ThisSet, SSetGet(OtherSet, x)) THEN EXIT FUNCTION
            NEXT x
            FUNCTION = 1
        END IF
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetContained(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS LONG

        'get number of items in OtherSet that are in ThisSet

        REGISTER x AS LONG
        LOCAL items AS LONG

        FOR x = 1 TO SSetCount(OtherSet)
            IF ISTRUE SSetContains(ThisSet, SSetGet(OtherSet, x)) THEN INCR items
        NEXT x
        FUNCTION = items
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetNotContained(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS LONG

        'get number of items in OtherSet that aren't in ThisSet

        REGISTER x AS LONG
        LOCAL items AS LONG

        FOR x = 1 TO SSetCount(OtherSet)
            IF ISFALSE SSetContains(ThisSet, SSetGet(OtherSet, x)) THEN INCR items
        NEXT x
        FUNCTION = items
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetEqual(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS BYTE

        'true if both Sets empty or both same size and contain same values

        IF SSetCount(ThisSet) = 0 AND SSetCount(OtherSet) = 0 THEN
            FUNCTION = 1
        ELSEIF SSetCount(ThisSet) = SSetCount(OtherSet) AND SSetContained(ThisSet, OtherSet) = SSetCount(ThisSet) THEN
            FUNCTION = 1
        END IF
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetSum(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS STRING

        'return unique Set of values that are in either Set

        LOCAL result AS STRING

        SSetAddSet result, ThisSet
        SSetAddSet result, OtherSet
        FUNCTION = result
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetDifference(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS STRING

        'return values that are in ThisSet but not in OtherSet

        LOCAL result AS STRING

        SSetAddSet result, ThisSet
        SSetSubtractSet result, OtherSet
        FUNCTION = result
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetCommon(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS STRING

        'return unique Set of values that are common to both Sets

        REGISTER x AS LONG
        LOCAL result AS STRING

        FOR x = 1 TO SSetCount(ThisSet)
            IF ISTRUE SSetContains(OtherSet, SSetGet(ThisSet, x)) THEN SSetAdd result, SSetGet(ThisSet, x)
        NEXT x
        FOR x = 1 TO SSetCount(OtherSet)
            IF ISTRUE SSetContains(ThisSet, SSetGet(OtherSet, x)) THEN SSetAdd result, SSetGet(OtherSet, x)
        NEXT x
        FUNCTION = result
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetUncommon(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS STRING

        'return unique Set of values that are uncommon to both Sets

        REGISTER x AS LONG
        LOCAL result AS STRING

        FOR x = 1 TO SSetCount(ThisSet)
            IF ISFALSE SSetContains(OtherSet, SSetGet(ThisSet, x)) THEN SSetAdd result, SSetGet(ThisSet, x)
        NEXT x
        FOR x = 1 TO SSetCount(OtherSet)
            IF ISFALSE SSetContains(ThisSet, SSetGet(OtherSet, x)) THEN SSetAdd result, SSetGet(OtherSet, x)
        NEXT x
        FUNCTION = result
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetCommonCount(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS LONG

        'get number of values common to both Sets

        LOCAL temp AS STRING

        temp = SSetCommon(ThisSet, OtherSet)
        FUNCTION = SSetCount(temp)
    END FUNCTION
    '-------------------------------------
    FUNCTION SSetUncommonCount(BYREF ThisSet AS STRING, BYREF OtherSet AS STRING) AS LONG

        'get number of values uncommon to both Sets

        LOCAL temp AS STRING

        temp = SSetUncommon(ThisSet, OtherSet)
        FUNCTION = SSetCount(temp)
    END FUNCTION
    '-------------------------------------
#ENDIF '%SSet230905

#IF NOT %DEF(%FileUtilities230424)
    %FileUtilities230424 = 1
    ' File Utilities
    ' public domain, use at own risk
    ' SDurham
    SUB StrToFile(BYVAL file AS WSTRING, BYVAL s AS STRING) THREADSAFE
        ' store string to File
        LOCAL f AS LONG
        IF LEN(file) = 0 THEN EXIT SUB
        f = FREEFILE
        OPEN file FOR BINARY AS f
        SETEOF f
        PUT$ f, s
        CLOSE f
    END SUB
    FUNCTION StrFromFile(BYVAL file AS WSTRING) THREADSAFE AS STRING
        ' get file contents as string
        LOCAL f AS LONG
        LOCAL s AS STRING
        IF ISFALSE ISFILE(file) THEN EXIT FUNCTION
        f = FREEFILE
        OPEN file FOR BINARY AS f
        GET$ f, LOF(f), s
        FUNCTION = s
        CLOSE f
    END FUNCTION
    SUB WStrToFile(BYVAL file AS WSTRING, BYVAL s AS WSTRING) THREADSAFE
        ' store string to File
        LOCAL f AS LONG
        IF LEN(file) = 0 THEN EXIT SUB
        f = FREEFILE
        OPEN file FOR BINARY AS f
        SETEOF f
        PUT$$ f, s
        CLOSE f
    END SUB
    FUNCTION WStrFromFile(BYVAL file AS WSTRING) THREADSAFE AS WSTRING
        ' get file contents as string
        LOCAL f AS LONG
        LOCAL s AS WSTRING
        IF ISFALSE ISFILE(file) THEN EXIT FUNCTION
        f = FREEFILE
        OPEN file FOR BINARY AS f
        GET$$ f, LOF(f), s
        FUNCTION = s
        CLOSE f
    END FUNCTION
    SUB WStrToTextFile(BYVAL file AS WSTRING, BYVAL s AS WSTRING) THREADSAFE
        ' store string converted to UTF8 to File
        StrToFile file, CHRTOUTF8$(s)
    END SUB
    FUNCTION WStrFromTextFile(BYVAL file AS WSTRING) AS WSTRING
        ' get file contents converted from UTF8
        FUNCTION = UTF8TOCHR$(StrFromFile(file))
    END FUNCTION
    FUNCTION WStrFromTextFileFixed(BYVAL file AS WSTRING) THREADSAFE AS WSTRING
        ' get file contents converted from UTF8 fixing Unix line endings if any
        LOCAL s AS WSTRING
        s = UTF8TOCHR$(StrFromFile(file))
        REPLACE $CRLF WITH $LF IN s
        REPLACE $CRLF WITH $LF IN s
        REPLACE $CR WITH $LF IN s
        REPLACE $CR WITH $LF IN s
        REPLACE $LF WITH $CRLF IN s
        FUNCTION = s
    END FUNCTION
#ENDIF '%FileUtilities230424�


Code Select
'Sarr.inc
'Public domain, use at own risk. SDurham

    'In-String: String Array, String Lookup Table, Unique Ordered String Set

    'In-String String Array

    'SarrComparison() set or change compare callback : default case sensitive
    'SarrSetMetadata() set metadata : each container can have a metadata string
    'SarrGetMetadata() get metadata
    'SarrCount() get item count
    'SarrClear() empty container
    'SarrReDim() only needed to set a specified number of items : space management automatic
    'SarrPack() get rid of dead space
    'SarrAdd() append value
    'SarrGet() get value at one-based index
    'SarrSet() set value at one-based index
    'SarrInsert() insert value at one-based index
    'SarrDelete() delete value at one-based index
    'SarrFastDelete() fast on massive array but destroys array order
    'SarrSort() quick sort
    'SarrSortSearch() binary search : optionally first or last
    'SarrSortInsert() binary insert : optionally ignore duplicates
    'SarrSortDelete() binary search and delete if found
    'SarrSortCount() get item count in sorted array
    'SarrReverse() reverse array
    'SarrPushFirst() insert value at front
    'SarrPushLast() append value to end
    'SarrPopFirst() get and remove first value
    'SarrPopLast() get and remove last value
    'SarrSplit() split array on delimited string
    'SarrJoin() join array to delimited string
    'SarrToTextFile() store array as text file
    'SarrFromTextFile() load text file
    'SarrFolders() get all folders in specified folder
    'SarrFiles() get all files in folder matching mask
    'SarrAllFolders() get all folders in specified folder and sub-folders
    'SarrAllFiles() get all files in specified folder, and sub-folders, matching mask

    'In-String Lookup Table

    'SashComparison() set compare callback : default case sensitive
    'SashSetMetadata() set metadata : each container can have a metadata string
    'SashGetMetadata() get metadata
    'SashCount() get item count
    'SashClear() empty container
    'SashPack() get rid of dead space
    'SashSet() add key and associated value : value replaced if key exist
    'SashGet() get key's associated value
    'SashContains() return zero if key not in table
    'SashDelete() delete key and associated value
    'SashGetKey() get key at one-based index
    'SashGetValue() get value at one-based index

    'Unique Ordered String Set

    'SSetSetMetadata()set metadata : each container can have a metadata string
    'SSetGetMetadata() get metadata
    'SSetCount() get Set count
    'SSetClear() empty Set
    'SSetPack() get rid of dead space
    'SSetGet() get value in Set at one-based index
    'SSetAdd() add value to Set : duplicates ignored
    'SSetSubtract() remove value from set
    'SSetContains() true/false if value in Set
    'SSetAddSet() add one Set to other : duplicates ignored
    'SSetSubtractSet() subtract one Set from other
    'SSetContainsSet() true/false if one Set is a subset of other
    'SSetContained() get number of items in one Set that are in other
    'SSetNotContained() get number of items in one Set that aren't in other
    'SSetEqual() true if Sets equal
    'SSetSum() get unique Set of values in two other Sets
    'SSetDifference() get the difference between two Sets
    'SSetCommon() get Set of values common to two Sets
    'SSetUncommon() get Set of values uncommon to two Sets
    'SSetCommonCount() get number of items common to two Sets
    'SSetUncommonCount() get number of items uncommon to two Sets

    'In-String String Array Performance
    'add 10,000 values to empty array = 0.000 seconds
    'get 10,000 values = 0.016 seconds
    'binary search array for 10,000 values = 0.031 seconds
    'add 10,000 strings 500 characters long = 0.141 seconds
    'add 10,000 strings 1,000 characters long = 0.486 seconds
    'fast delete 10,000 values = 0.031 seconds

    'add 100,000 values to empty array = 0.047 seconds
    'get 100,000 values = 0.015 seconds
    'sort array of 100,000 random values = 0.490 seconds
    'binary search array for 100,000 values = 0.352 seconds
    'add 100,000 strings 100 characters long = 0.360 seconds
    'add 100,000 strings 500 characters long = 9.780 seconds
    'fast delete 100,000 values = 0.409 seconds

    'add 1,000,000 values to empty array = 1.489
    'get 1,000,000 values = 0.189
    'sort array of 1,000,000 random values = 6.442 seconds
    'binary search array for 1,000,000 values = 5.315 seconds
    'add 1,000,000 strings 100 characters long = 50.119 seconds
    'fast delete 1,000,000 values = 5.470 seconds

    'add 100 strings 1,000,000 characters long = 1.883 seconds

    'In-String Lookup Table Performance

    'add 10,000 random key/values to hash table = 0.267 seconds
    'find 10,000 keys = 0.078 seconds
    'get 10,000 values using key = 0.078 seconds

    'add 20,000 random key/values to hash table = 0.723 seconds
    'find 20,000 keys = 0.159
    'get 20,000 values using key = 0.174 seconds

    'add 30,000 random key/values to hash table = 1.271 seconds
    'find 30,000 keys = 0.251 seconds
    'get 30,000 values using key = 0.266 seconds

    'add 40,000 random key/values to hash table = 1.888 seconds
    'find 40,000 keys = 0.345 seconds
    'get 40,000 values using key = 0.377 seconds

    'add 50,000 random key/values to hash table = 2.676 seconds
    'find 50,000 keys = 0.447 seconds
    'get 50,000 values using key = 0.475 seconds

    'add 60,000 random key/values to hash table = 3.531 seconds
    'find 60,000 keys = 0.615 seconds
    'get 60,000 values using key = 0.612

    'add 70,000 random key/values to hash table = 4.673 seconds
    'find 70,000 keys = 0.659 seconds
    'get 70,000 values using key = 0.675 seconds

    'add 80,000 random key/values to hash table = 5.690 seconds
    'find 80,000 keys = 0.786 seconds
    'get 80,000 values using key = 0.800

    'add 90,000 random key/values to hash table = 6.893 seconds
    'find 90,000 keys = 0.899 seconds
    'get 90,000 values using key = 0.942 seconds

    'add 100,000 random key/values to hash table = 8.224 seconds
    'find 100,000 keys = 1.020 seconds
    'get 100,000 values using key = 0.991 seconds

#If Not %Def(%Sarr230829)
    %Sarr230829 = 1
    'InString String Array
    'Container protected with hash tag.
    Declare Function SarrCompare(ByRef a As String, ByRef b As String) As Long
        'compare callback template
        'a < b : return < 0
        'a = b : return = 0
        'a > b : return > 0
    Macro SarrTag = 1783209428
    Macro SarrMetadataSpace = 20
    Macro SarrHeaderSize = (5 * 4) + SarrMetadataSpace + 1
    Macro SarrRecordSize = 8
    Macro SarrRecordBufferMax = 10000
    Macro SarrRecordBufferMin = 4
    Macro SarrCharacterBufferMax = 40000
    Macro SarrCharacterBufferMin = 40
    Macro SarrRecordMultiplier = 2
    Macro SarrCharacterMultiplier = 5
    '   12345678901234567890123456789012345678901234567890  string position
    '                1234567890123456789012345678901234567  position in string space
    '   :header:array:used string space:free string space:
    '   56789012345678901234567890123456789012345678901234  string pointer position
    '   : left side  : right side                        :
    '   : metadata   : character space                   :
    Type SarrHeaderT
        tag As Long
        count As Long
        max As Long
        used As Long
        compare As Long
        metadata As String * SarrMetadataSpace
    End Type
    Type SarrRecordT
        charSpaceOffset As Long
        bytes As Long
    End Type
    #If Not %Def(%Unicode)
        %Unicode = 1
    #EndIf '%Unicode
    '-------------------------------------
    '-------------------------------------
    '   String Array
    '-------------------------------------
    '-------------------------------------
    Sub SarrComparison(ByRef container As String, ByVal compareCB As Long)
        'change compare callback which changes sort and binary search order
        'default = case sensitive : CodePtr(SarrCompare)
        'CodePtr(SarrCompare) = case sensitive
        'CodePtr(SarrCompareUCase) = ignore case
        'CodePtr(procedure) for custom comparison
        If Len(container) = 0 Then SarrInitialize(container)
        If Cvl(container) <> SarrTag Then Exit Sub
        If compareCB Then SarrSetCompare container, compareCB
    End Sub
    '-------------------------------------
    Sub SarrSetMetadata((ByRef container As String, ByVal value As String)
        Local p As SarrHeaderT Ptr
        'there is SarrMetadataSpace in each container for metadata
        'set metadata
        If Len(container) = 0 Then SarrInitialize(container)
        If Cvl(container) <> SarrTag Then Exit Sub
        p = StrPtr(container)
        @p.metadata = value
    End Sub
    '-------------------------------------
    Function SarrGetMetadata(ByRef container As String) As String
        Local p As SarrHeaderT Ptr
        'there is SarrMetadataSpace in each container for metadata
        'get metadata
        If Cvl(container) <> SarrTag Then Exit Function
        p = StrPtr(container)
        Function = Trim$(@p.metadata)
    End Function
    '-------------------------------------
    Function SarrCount(ByRef container As String) As Long
        'get item count
        If Len(container) And Cvl(container) = SarrTag Then Function = SarrGetCount(container)
    End Function
    '-------------------------------------
    Sub SarrClear(ByRef container As String)
        'empty container
        Local compareCB As Long
        Local metadata As String
        If Len(container) Then
            If Cvl(container) <> SarrTag Then Exit Sub
            compareCB = SarrGetCompare(container)
            metadata = SarrGetMetadata(container)
            container = ""
            SarrInitialize(container)
            SarrSetCompare container, compareCB
            SarrSetMetadata container, metadata
        End If
    End Sub
    '-------------------------------------
    Sub SarrReDim(ByRef container As String, ByVal items As Long)
        'redimension array : data preserved
        'doesn't need be called, array is buffered
        'use to set a specified number of items
        If Len(container) = 0 Then SarrInitialize(container)
        If Cvl(container) <> SarrTag Then Exit Sub
        If items >= 0 Then
            While SarrGetCount(container) < items
                SarrPushLast container, ""
            Wend
            While SarrGetCount(container) > items
                SarrPopLast(container)
            Wend
        End If
    End Sub
    '-------------------------------------
    Sub SarrPack(ByRef container As String)
        'get rid of dead space
        Register i As Long
        Local items, usedCharacters As Long
        Local leftSide, rightSide As String
        Local a() As String
        If Cvl(container) <> SarrTag Then Exit Sub
        items = SarrGetCount(container)
        usedCharacters = SarrGetUsed(container)
        If items = 0 Then
            SarrClear(container)
        Else
            ReDim a(1 To items)
            For i = 1 To items
                a(i) = SarrGet(container, i)
            Next x
            SarrClear container
            For i = 1 To items
                SarrAdd container, a(i)
            Next x
            Erase a()
            leftSide = Left$(container, SarrHeaderSize + (items * SarrRecordSize))
            rightSide = Right$(container, SarrRight(container))
            rightSide = Left$(rightSide, usedCharacters)
            container = leftSide + rightSide
            SarrSetMax container, items
        End If
    End Sub
    '-------------------------------------
    Sub SarrAdd(ByRef container As String, ByVal value As String)
        'append value
        Local bytes, charSpaceOffset, mem As Long
        Local rec() As SarrRecordT
        'get needed character space
        bytes = Len(value)
        If Len(container) = 0 Then SarrInitialize(container)
        If Cvl(container) <> SarrTag Then Exit Sub
        'add more records if needed
        If SarrGetCount(container) = SarrGetMax(container) Then SarrMoreRecords(container)
        'add more character space if needed
        If SarrUnusedCharacters(container) < bytes Then SarrMoreCharacters(container, bytes)
        'store value
        charSpaceOffset = SarrGetUsed(container)
        SarrSetUsed container, charSpaceOffset + bytes
        mem = StrPtr(container) + SarrLeft(container) + charSpaceOffset
        Memory Copy StrPtr(value), mem, bytes
        SarrSetCount container, SarrGetCount(container) + 1
        ReDim rec(1 To SarrGetMax(container)) At SarrArrMem(container)
        rec(SarrGetCount(container)).charSpaceOffset = charSpaceOffset
        rec(SarrGetCount(container)).bytes = bytes
    End Sub
    '-------------------------------------
    Function SarrGet(ByRef container As String, ByVal index As Long) As String
        'get value at one-based index
        Local mem, charSpaceOffset, bytes As Long
        Local rec() As SarrRecordT
        If Cvl(container) <> SarrTag Then Exit Function
        If index < 1 Or index > SarrGetCount(container) Then Exit Function
        ReDim rec(1 To SarrGetMax(container)) At SarrArrMem(container)
        charSpaceOffset = rec(index).charSpaceOffset
        bytes = rec(index).bytes
        mem = StrPtr(container) + SarrLeft(container) + charSpaceOffset
        Function = Peek$(mem, bytes)
    End Function
    '-------------------------------------
    Sub SarrSet(ByRef container As String, ByVal index As Long, ByVal value As String)
        'set value at one-based index
        Local mem, charSpaceOffset, bytes As Long
        Local rec() As SarrRecordT
        If Cvl(container) <> SarrTag Then Exit Sub
        If index < 1 Or index > SarrGetCount(container) Then Exit Sub
        'get needed character space
        bytes = Len(value)
        'replace string
        ReDim rec(1 To SarrGetMax(container)) At SarrArrMem(container)
        If bytes > rec(index).bytes Then
            'abandon old string space
            'add more character space if needed
            If SarrUnusedCharacters(container) < bytes Then SarrMoreCharacters(container, bytes)
            'store value in new space
            charSpaceOffset = SarrGetUsed(container)
            SarrSetUsed container, charSpaceOffset + bytes
            mem = StrPtr(container) + SarrLeft(container) + charSpaceOffset
            Memory Copy StrPtr(value), mem, bytes
            ReDim rec(1 To SarrGetMax(container)) At SarrArrMem(container)
            rec(index).charSpaceOffset = charSpaceOffset
            rec(index).bytes = bytes
        Else
            'we have enough space
            rec(index).bytes = bytes
            charSpaceOffset = rec(index).charSpaceOffset
            mem = StrPtr(container) + SarrLeft(container) + charSpaceOffset
            Memory Copy StrPtr(value), mem, bytes
        End If
    End Sub
    '-------------------------------------
    Sub SarrInsert(ByRef container As String, ByVal index As Long, ByVal value As String)
        'insert value at one-based index
        Local charSpaceOffset, mem, bytes As Long
        Local qud() As Quad
        Local rec() As SarrRecordT
        If Cvl(container) <> SarrTag Then Exit Sub
        If index < 1 Or index > SarrGetCount(container) Then Exit Sub
        'get needed character space
        bytes = Len(value)
        'add more records if needed : we need two more
        If SarrGetMax(container) = SarrGetCount(container) Then SarrMoreRecords(container)
        'add more character space if needed
        If SarrUnusedCharacters(container) < bytes Then SarrMoreCharacters(container, bytes)
        'insert record space
        ReDim qud(1 To SarrGetMax(container)) At SarrArrMem(container)
        Array Insert qud(index), 0
        SarrSetCount container, SarrGetCount(container) + 1
        'store value
        charSpaceOffset = SarrGetUsed(container)
        SarrSetUsed container, charSpaceOffset + bytes
        mem = StrPtr(container) + SarrLeft(container) + charSpaceOffset
        Memory Copy StrPtr(value), mem, bytes
        ReDim rec(1 To SarrGetMax(container)) At SarrArrMem(container)
        rec(index).charSpaceOffset = charSpaceOffset
        rec(index).bytes = bytes
    End Sub
    '-------------------------------------
    Sub SarrDelete(ByRef container As String, ByVal index As Long)
        'delete value at one-based index
        Local qud() As Quad
        If Cvl(container) <> SarrTag Then Exit Sub
        If index < 1 Or index > SarrGetCount(container) Then Exit Sub
        ReDim qud(1 To SarrGetCount(container)) At SarrArrMem(container)
        Array Delete qud(index)
        SarrSetCount container, SarrGetCount(container) - 1
    End Sub
    '-------------------------------------
    Sub SarrFastDelete(ByRef container As String, ByVal index As Long)
        'fast delete value at one-based index
        'fast on massive array but destroys array order
        'traverse back to front to use
        Local qud() As Quad
        If Cvl(container) <> SarrTag Then Exit Sub
        If index < 1 Or index > SarrGetCount(container) Then Exit Sub
        ReDim qud(1 To SarrGetCount(container)) At SarrArrMem(container)
        If index < SarrGetCount(container) Then Swap qud(index), qud(SarrGetCount(container))
        SarrSetCount container, SarrGetCount(container) - 1
    End Sub
    '-------------------------------------
    '-------------------------------------
    '   Sort Order
    '-------------------------------------
    '-------------------------------------
    Sub SarrSort(ByRef container As String)
        'non-recursive quick sort
        Register i As Long
        Register j As Long
        Local k, leftIndex, rightIndex, counter, compareCB, compare As Long
        Local value As String
        Local qud() As Quad
        If Cvl(container) <> SarrTag Then Exit Sub
        compareCB = SarrGetCompare(container)
        leftIndex = 1
        rightIndex = SarrGetCount(container)
        If rightIndex > 1 Then
            ReDim qud(1 To rightIndex) At SarrArrMem(container)
            counter = 1
            !PUSH leftIndex
            !PUSH rightIndex
            While counter
                Decr counter
                !POP rightIndex
                !POP leftIndex
                i = leftIndex
                j = rightIndex
                k = i + j
                Shift Right k, 1
                value = SarrGet(container, k)
                While i <= j
                    Call Dword compareCB Using SarrCompare(SarrGet(container, i), value) To compare
                    While compare < 0
                        Incr i
                        Call Dword compareCB Using SarrCompare(SarrGet(container, i), value) To compare
                    Wend
                    Call Dword compareCB Using SarrCompare(SarrGet(container, j), value) To compare
                    While compare > 0
                        Decr j
                        Call Dword compareCB Using SarrCompare(SarrGet(container, j), value) To compare
                    Wend
                    If i <= j Then
                        Swap qud(i), qud(j) : Incr i : Decr j
                    End If
                Wend
                If leftIndex < j Then
                    !PUSH leftIndex
                    !PUSH j
                    Incr counter
                End If
                If i < rightIndex Then
                    !PUSH i
                    !PUSH rightIndex
                    Incr counter
                End If
            Wend
        End If
    End Sub
    '-------------------------------------
    Function SarrSortSearch(ByRef container As String, ByVal value As String, Opt ByVal findFirst As Long, Opt ByVal findLast As Long) As Long
        'binary search for value : return index : zero if not found : array must be sorted
        'if IsTrue findFirst then first instance found
        'if IsTrue findLast then last instance found
        Register i As Long
        Register j As Long
        Local bot, top, result, compareCB, compare As Long
        If Cvl(container) <> SarrTag Then Exit Function
        compareCB = SarrGetCompare(container)
        bot = 1
        top = SarrGetCount(container)
        If top Then
            While top >= bot
                i = bot + top
                Shift Right i, 1 'divide by 2
                Call Dword compareCB Using SarrCompare(value, SarrGet(container, i)) To compare
                If compare > 0 Then
                    bot = i + 1
                ElseIf compare < 0 Then
                    top = i - 1
                Else
                    result = i
                    If IsTrue findFirst Then
                        For j = i - 1 To 1 Step -1
                            Call Dword compareCB Using SarrCompare(value, SarrGet(container, j)) To compare
                            If compare = 0 Then
                                result = j
                            Else
                                Exit For
                            End If
                        Next j
                    ElseIf IsTrue findLast Then
                        For j = i + 1 To SarrGetCount(container)
                            Call Dword compareCB Using SarrCompare(value, SarrGet(container, j)) To compare
                            If compare = 0 Then
                                result = j
                            Else
                                Exit For
                            End If
                        Next j
                    End If
                    Function = result
                    Exit Function
                End If
            Wend
        End If
    End Function
    '-------------------------------------
    Sub SarrSortInsert(ByRef container As String, ByVal value As String, Opt ByVal unique As Long)
        'insert value at sort position : added if empty : array must be sorted or empty
        'if IsTrue unique then duplicates ignored
        Register i As Long
        Local bot, top, compareCB, compare As Long
        If Len(container) = 0 Then SarrInitialize(container)
        If Cvl(container) <> SarrTag Then Exit Sub
        compareCB = SarrGetCompare(container)
        bot = 1
        top = SarrGetCount(container)
        If top Then
            While top >= bot
                i = bot + top
                Shift Right i, 1 'divide by 2
                Call Dword compareCB Using SarrCompare(value, SarrGet(container, i)) To compare
                If compare > 0 Then
                    bot = i + 1
                ElseIf compare < 0 Then
                    top = i - 1
                Else
                    If IsFalse unique Then SarrInsert(container, i, value)
                    Exit Sub
                End If
            Wend
            If compare < 0 Then
                SarrInsert(container, i, value)
            ElseIf i < SarrGetCount(container) Then
                SarrInsert(container, i + 1, value)
            Else
               SarrAdd(container, value)
            End If
        Else
            SarrAdd(container, value)
        End If
    End Sub
    '-------------------------------------
    Sub SarrSortDelete(ByRef container As String, ByVal value As String)
        'delete one instance of value if in array maintaining sort order : array must be sorted
        Local x As Long
        x = SarrSortSearch(container, value)
        If x Then SarrDelete container, x
    End Sub
    '-------------------------------------
    Function SarrSortCount(ByRef container As String, ByVal value As String) As Long
        'get value's instance count : array must be sorted
        Local first, last As Long
        first = SarrSortSearch(container, value, 1, 0)
        last = SarrSortSearch(container, value, 0, 1)
        Function = last - first + 1
    End Function
    '-------------------------------------
    Sub SarrReverse(ByRef container As String)
        'reverse array
        Register i As Long
        Register j As Long
        Local qud() As Quad
        If Cvl(container) <> SarrTag Then Exit Sub
        i = 1
        j = SarrGetCount(container)
        If j > 1 Then
            ReDim qud(1 To SarrGetMax(container)) At SarrArrMem(container)
            While i < j
                Swap qud(i), qud(j)
                Incr i
                Decr j
            Wend
        End If
    End Sub
    '-------------------------------------
    '-------------------------------------
    '   Stack and Queue
    '-------------------------------------
    '-------------------------------------
    Sub SarrPushFirst(ByRef container As String, ByVal value As String)
        'insert value at front
        If SarrCount(container) Then SarrInsert(container, 1, value) Else SarrAdd(container, value)
    End Sub
    '-------------------------------------
    Sub SarrPushLast(ByRef container As String, ByVal value As String)
        'append value to end of array
        SarrAdd container, value
    End Sub
    '-------------------------------------
    Function SarrPopFirst(ByRef container As String) As String
        'get and remove first value in array
        If SarrCount(container) Then
            Function = SarrGet(container, 1)
            SarrDelete container, 1
        End If
    End Function
    '-------------------------------------
    Function SarrPopLast(ByRef container As String) As String
        'get and remove first value in array
        Local items As Long
        items = SarrCount(container)
        If items Then
            Function = SarrGet(container, items)
            SarrDelete container, items
        End If
    End Function
    '-------------------------------------
    '-------------------------------------
    '   Split and Join
    '-------------------------------------
    '-------------------------------------
    Sub SarrSplit(ByRef container As String, ByVal delimitedString As String, ByVal delimiter As String)
        'split array on delimited string
        Register i As Long
        Local items As Long
        Local a() As String
        SarrClear container
        If Len(delimitedString) Then
            items = ParseCount(delimitedString, delimiter)
            If items Then
                ReDim a(1 To items)
                Parse delimitedString, a(), delimiter
                For i = 1 To items
                    SarrAdd container, a(i)
                Next x
            End If
        End If
    End Sub
    '-------------------------------------
    Function SarrJoin(ByRef container As String, ByVal delimiter As String) As String
        'join array to delimited string
        Register i As Long
        Local items As Long
        Local a() As WString
        If Len(container) = 0 Then SarrInitialize(container)
        If Cvl(container) <> SarrTag Then Exit Function
        items = SarrCount(container)
        If items Then
            ReDim a(1 To items)
            For i = 1 To items
                a(i) = Utf8ToChr$(SarrGet(container, i))
            Next x
            Function = Join$(a(), delimiter)
        End If
    End Function
    '-------------------------------------
    '-------------------------------------
    '   To/From Text File
    '-------------------------------------
    '-------------------------------------
    Sub SarrToTextFile(ByRef container As String, ByVal file As WString)
        'store array as text file
        StrToFile file, Trim$(SarrJoin(container, $CrLf), $CrLf) + $CrLf
    End Sub
    '-------------------------------------
    Sub SarrFromTextFile(ByRef container As String, ByVal file As WString)
        'load text file
        If Len(container) = 0 Then SarrInitialize(container)
        SarrSplit container, Trim$(StrFromFile(file), $CrLf), $CrLf
    End Sub
    '-------------------------------------
    '-------------------------------------
    '   File and Folder List
    '-------------------------------------
    '-------------------------------------
    Sub SarrFolders(ByRef container As String, ByVal specifiedFolder As WString)
        'get all folders in specified folder
        'items stored UTF8
        Local folder, folderMask, specifiedPath As WString
        Local DrD As DirData
        If Len(container) = 0 Then SarrInitialize(container)
        SarrClear container
        If IsFalse IsFolder(specifiedFolder) Then Exit Sub
        specifiedPath = RTrim$(specifiedFolder, "\") + "\"
        folderMask = specifiedPath
        folder = Dir$(folderMask, Only %SubDir To DrD)
        While Len(folder)
            SarrAdd container, ChrToUtf8$(specifiedPath + folder)
            folder = Dir$
        Wend
    End Sub
    '-------------------------------------
    Sub SarrFiles(ByRef container As String, ByVal specifiedFolder As WString, ByVal mask As WString)
        'get all files in folder matching mask
        'items stored UTF8
        Local file, fileMask As WString
        If Len(container) = 0 Then SarrInitialize(container)
        SarrClear container
        If IsFalse IsFolder(specifiedFolder) Then Exit Sub
        specifiedFolder = RTrim$(specifiedFolder, "\") + "\"
        fileMask = specifiedFolder + mask
        file = Dir$(fileMask)
        While Len(file)
            SarrAdd container, ChrToUtf8$(specifiedFolder + file)
            file = Dir$
        Wend
    End Sub
    '-------------------------------------
    Sub SarrAllFolders(ByRef container As String, ByVal specifiedFolder As WString)
        'get all folders in specified folder and sub-folders
        'items stored UTF8
        Local foldersArr, subFoldersArr As String
        Local currentFolder As WString
        If Len(container) = 0 Then SarrInitialize(container)
        SarrClear container
        If IsFalse IsFolder(specifiedFolder) Then Exit Sub
        SarrPushLast foldersArr, specifiedFolder
        While SarrCount(foldersArr)
            currentFolder = SarrPopLast(foldersArr)
            SarrAdd container, currentFolder
            SarrFolders subFoldersArr, currentFolder
            While SarrCount(subFoldersArr)
                SarrPushLast foldersArr, SarrPopLast(subFoldersArr)
            Wend
        Wend
    End Sub
    '-------------------------------------
    Sub SarrAllFiles(ByRef container As String, ByVal specifiedFolder As WString, ByVal mask As WString)
        'get all files in specified folder, and sub-folders, matching mask
        'items stored UTF8
        Local allFoldersArr, folderFilesArr As String
        If Len(container) = 0 Then SarrInitialize(container)
        SarrClear container
        If IsFalse IsFolder(specifiedFolder) Then Exit Sub
        SarrAllFolders allFoldersArr, specifiedFolder
        While SarrCount(allFoldersArr)
            SarrFiles folderFilesArr, SarrPopLast(allFoldersArr), mask
            While SarrCount(folderFilesArr)
                SarrAdd container, SarrPopLast(folderFilesArr)
            Wend
        Wend
    End Sub
    '-------------------------------------
    '-------------------------------------
    '   PRIVATE
    '-------------------------------------
    '-------------------------------------
    Sub SarrSetTag(ByRef container As String, ByVal value As Long)  Private
        'set container header tag parameter
        If Len(container) Then Poke Long, StrPtr(container), value
    End Sub
    '-------------------------------------
    Function SarrGetCount(ByRef container As String)  Private As Long
        'get container header count parameter
        If Len(container) Then Function = Peek(Long, StrPtr(container) + 4)
    End Function
    '-------------------------------------
    Sub SarrSetCount(ByRef container As String, ByVal value As Long) Private
        'set container header count parameter
        If Len(container) Then Poke Long, StrPtr(container) + 4, value
    End Sub
    '-------------------------------------
    Function SarrGetMax(ByRef container As String) Private As Long
        'get container header max parameter
        If Len(container) Then Function = Peek(Long, StrPtr(container) + 8)
    End Function
    '-------------------------------------
    Sub SarrSetMax(ByRef container As String, ByVal value As Long) Private
        'set container header max parameter
        If Len(container) Then Poke Long, StrPtr(container) + 8, value
    End Sub
    '-------------------------------------
    Function SarrGetUsed(ByRef container As String) Private As Long
        'get container header used parameter
        If Len(container) Then Function = Peek(Long, StrPtr(container) + 12)
    End Function
    '-------------------------------------
    Sub SarrSetUsed(ByRef container As String, ByVal value As Long) Private
        'set container header used  parameter
        If Len(container) Then Poke Long, StrPtr(container) + 12, value
    End Sub
    '-------------------------------------
    Function SarrGetCompare(ByRef container As String)  Private As Long
        'get container header compare parameter
        If Len(container) Then Function = Peek(Long, StrPtr(container) + 16)
    End Function
    '-------------------------------------
    Sub SarrSetCompare(ByRef container As String, ByVal value As Long) Private
        'set container header compare  parameter
        If Len(container) Then Poke Long, StrPtr(container) + 16, value
    End Sub
    '-------------------------------------
    Sub SarrInitialize(ByRef container As String) Private
        'initialize container : not necessary to call : automatic
        container = Nul$(SarrHeaderSize + (SarrRecordBufferMin * SarrRecordSize) + SarrCharacterBufferMin)
        SarrSetTag container, SarrTag
        SarrSetMax container, SarrRecordBufferMin
        SarrSetCompare container, CodePtr(SarrCompare)
    End Sub
    '-------------------------------------
    Function SarrArrSize(ByRef container As String) Private As Long
        'get size of record array
        Function = SarrGetMax(container) * SarrRecordSize
    End Function
    '-------------------------------------
    Function SarrArrMem(ByRef container As String) Private As Long
        'get record array memory address
        Function = StrPtr(container) + SarrHeaderSize
    End Function
    '-------------------------------------
    Function SarrLeft(ByRef container As String) Private As Long
        'get length of left side
        Function = SarrHeaderSize + SarrArrSize(container)
    End Function
    '-------------------------------------
    Function SarrRight(ByRef container As String) Private As Long
        'get length of right side
        Function = Len(container) - SarrLeft(container)
    End Function
    '-------------------------------------
    Sub SarrMoreRecords(ByRef container As String) Private
        'add more record space
        Local buffer As Long
        Local leftSide, rightSide As String
        buffer = SarrGetCount(container) * SarrRecordMultiplier
        If buffer < SarrRecordBufferMin Then buffer = SarrRecordBufferMin
        If buffer > SarrRecordBufferMax Then buffer = SarrRecordBufferMax
        rightSide = Right$(container, SarrRight(container))
        leftSide = Left$(container, SarrLeft(container))
        leftSide += Nul$(buffer * SarrRecordSize)
        container = leftSide + rightSide
        SarrSetMax container, SarrGetMax(container) + buffer
    End Sub
    '-------------------------------------
    Sub SarrMoreCharacters(ByRef container As String, ByVal bytes As Long) Private
        'add more character space
        Local buffer As Long
        Local p As SarrHeaderT Ptr
        p = StrPtr(container)
        buffer = SarrGetCount(container) * SarrCharacterMultiplier
        If buffer < SarrCharacterBufferMin Then buffer = SarrCharacterBufferMin
        If buffer > SarrCharacterBufferMax Then buffer = SarrCharacterBufferMax
        container += Nul$(buffer + bytes)
    End Sub
    '-------------------------------------
    Function SarrUnusedCharacters(ByRef container As String) Private As Long
        'get unused character space
        Function = Len(container) - SarrLeft(container) - SarrGetUsed(container)
    End Function
    '-------------------------------------
    '-------------------------------------
    '   Callback Functions
    '-------------------------------------
    '-------------------------------------
    Function SarrCompare(ByRef a As String, ByRef b As String) Private As Long
        'case sensitive compare callback
        Function = Switch&(a < b, -1, a > b, 1) 'else match
    End Function
    '-------------------------------------
    Function SarrCompareUCase(ByRef a As String, ByRef b As String) Private As Long
        'upper case compare callback
        Local ua As String : ua = UCase$(a)
        Local ub As String : ub = UCase$(b)
        Function = Switch&(ua < ub, -1, ua > ub, 1) 'else match
    End Function
    '-------------------------------------
#EndIf '%Sarr230829

#If Not %Def(%Sash230903)
    %Sash230903 = 1
    'InString Hash Table
    'Value stored and retrieved using unique lookup key.
    'Keys are case sensitive.
    'Key and value can be any kind of binary data, nulls, MK_$,  ChrToUtf8$(), ...
    'Uses string array and binary search and insert.
    'Stays in key ordr.
    '-------------------------------------
    '-------------------------------------
    '   Hash Table
    '-------------------------------------
    '-------------------------------------
    '-------------------------------------
    Sub SashComparison(ByRef container As String, ByVal compareCB As Long)
        'this implementation stays in key order
        '!!! must be changed before use, will erase all data !!!
        'default is case sensitive : CodePtr(SashCompare)
        'set CodePtr(SashCompareUCase) to ignore case
        'set CodePtr(procedure) for custom comparison
        '   modify provided callbacks
        '   keep in mind that only unique keys are allowed
        If Len(container) = 0 Then SarrInitialize(container)
        If Cvl(container) <> SarrTag Then Exit Sub
        SashClear container
        If compareCB Then SarrSetCompare container, compareCB
    End Sub
    '-------------------------------------
    Sub SashSetMetadata((ByRef container As String, ByVal value As String)
        'there is SarrMetadataSpace in each container for metadata
        'set metadata
        SarrSetMetadata container, value
    End Sub
    '-------------------------------------
    Function SashGetMetadata(ByRef container As String) As String
        'there is SarrMetadataSpace in each container for metadata
        'get metadata
        Function = SarrGetMetadata(container)
    End Function
    '-------------------------------------
    Function SashCount(ByRef container As String) As Long
        'get item count
        If Len(container) And Cvl(container) = SarrTag Then Function = SarrGetCount(container)
    End Function
    '-------------------------------------
    Sub SashClear(ByRef container As String)
        'empty container
        SarrClear container
    End Sub
    '-------------------------------------
    Sub SashPack(ByRef container As String)
        'get rid of dead space
        Local x As Long
        Local KeyValArr As String
        If Cvl(container) <> SarrTag Then Exit Sub
        For x = 1 To SarrCount(container)
            KeyValArr = SarrGet(container, x)
            SarrPack KeyValArr
            SarrSet container, x, KeyValArr
        Next x
        SarrPack container
    End Sub
    '-------------------------------------
    Sub SashSet(ByRef container As String, ByVal key As String, ByVal value As String)
        'add key and associated value : value replaced if key exist
        Local x As Long
        Local KeyValArr As String
        SarrComparison container, CodePtr(SashCompare)
        If Cvl(container) <> SarrTag Then Exit Sub
        SarrRedim KeyValArr, 2
        SarrSet KeyValArr, 1, key
        SarrSet KeyValArr, 2, value
        x = SarrSortSearch(container, KeyValArr)
        If x Then
            SarrSet container, x, KeyValArr
        Else
            SarrSortInsert container, KeyValArr
        End If
    End Sub
    '-------------------------------------
    Function SashGet(ByRef container As String, ByVal key As String) As String
        'get key's associated value
        Local x As Long
        Local KeyValArr As String
        x = SashContains(container, key)
        If x Then
            KeyValArr = SarrGet(container, x)
            Function = SarrGet(KeyValArr, 2)
        End If
    End Function
    '-------------------------------------
    Function SashContains(ByRef container As String, ByVal key As String) As Long
        'return zero if key not in table
        Local x As Long
        Local KeyValArr As String
        If Cvl(container) <> SarrTag Then Exit Function
        SarrRedim KeyValArr, 2
        SarrSet KeyValArr, 1, key
        Function = SarrSortSearch(container, KeyValArr)
    End Function
    '-------------------------------------
    Sub SashDelete(ByRef container As String, ByVal key As String)
        'delete key and associated value
        Local KeyValArr As String
        SarrRedim KeyValArr, 2
        SarrSet KeyValArr, 1, key
        SarrSortDelete container, KeyValArr
    End Sub
    '-------------------------------------
    Function SashGetKey(ByRef container As String, ByVal index As Long) As String
        'get key at one-based index
        Local KeyValArr As String
        KeyValArr = SarrGet(container, index)
        If Len(KeyValArr) Then Function = SarrGet(KeyValArr, 1)
    End Function
    '-------------------------------------
    Function SashGetValue(ByRef container As String, ByVal index As Long) As String
        'get value at one-based index
        Local KeyValArr As String
        KeyValArr = SarrGet(container, index)
        If Len(KeyValArr) Then Function = SarrGet(KeyValArr, 2)
    End Function
    '-------------------------------------
    '-------------------------------------
    '   PRIVATE
    '-------------------------------------
    '-------------------------------------
    Function SashCompare(ByRef a As String, ByRef b As String) Private As Long
        'case sensitive compare callback
        Local keyA As String : keyA = SarrGet(a, 1)
        Local keyB As String : keyB = SarrGet(b, 1)
        Function = Switch&(keyA < keyB, -1, keyA > keyB, 1) 'else match
    End Function
    Function SashCompareUCase(ByRef a As String, ByRef b As String) Private As Long
        'case sensitive compare callback
        Local keyA As String : keyA = UCase$(SarrGet(a, 1))
        Local keyB As String : keyB = UCase$(SarrGet(b, 1))
        Function = Switch&(keyA < keyB, -1, keyA > keyB, 1) 'else match
    End Function
#EndIf '%Sash230903

#If Not %Def(%SSet230905)
    %SSet230905 = 1
    'Each Set is a group of unique values.
    'Comparison is case sensitive.
    '-------------------------------------
    '-------------------------------------
    '   Unique Ordered String Set
    '-------------------------------------
    '-------------------------------------
    Sub SSetSetMetadata(ByRef ThisSet As String, ByVal value As String)
        'there is SarrMetadataSpace in each container for metadata
        'set metadata
        SarrSetMetadata ThisSet, value
    End Sub
    '-------------------------------------
    Function SSetGetMetadata(ByRef ThisSet As String) As String
        'there is SarrMetadataSpace in each container for metadata
        'get metadata
        Function = SarrGetMetadata(ThisSet)
    End Function
    '-------------------------------------
    Function SSetCount(ByRef ThisSet As String) As Long
        'get unique items in ThisSet
        Function = SarrCount(ThisSet)
    End Function
    '-------------------------------------
    Sub SSetClear(ByRef ThisSet As String)
        'empty ThisSet
        SarrClear ThisSet
    End Sub
    '-------------------------------------
    Sub SSetPack(ByRef ThisSet As String)
        'get rid of dead space
        SarrPack ThisSet
    End Sub
    '-------------------------------------
    Function SSetGet(ByRef ThisSet As String, ByVal index As Long) As String
        'get value in ThisSet at one-based index
        Function = SarrGet(ThisSet, index)
    End Function
    '-------------------------------------
    Sub SSetAdd(ByRef ThisSet As String, ByVal value As String)
        'add value to ThisSet : ignored if duplicate
        SarrSortInsert ThisSet, value, 1
    End Sub
    '-------------------------------------
    Sub SSetSubtract(ByRef ThisSet As String, ByVal value As String)
        'remove value if in ThisSet
        SarrSortDelete ThisSet, value
    End Sub
    '-------------------------------------
    Function SSetContains(ByRef ThisSet As String, ByVal value As String) As Byte
        'true/false if value in ThisSet
        If SarrSortSearch(ThisSet, value) Then Function = 1
    End Function
    '-------------------------------------
    Sub SSetAddSet(ByRef ThisSet As String, ByRef OtherSet As String)
        'add OtherSet to ThisSet : duplicates ignored
        Register x As Long
        For x = 1 To SSetCount(OtherSet)
            SSetAdd ThisSet, SSetGet(OtherSet, x)
        Next x
    End Sub
    '-------------------------------------
    Sub SSetSubtractSet(ByRef ThisSet As String, ByRef OtherSet As String)
        'remove all values from ThisSet that are in OtherSet
        Register x As Long
        For x = 1 To SSetCount(OtherSet)
            SSetSubtract ThisSet, SSetGet(OtherSet, x)
        Next x
    End Sub
    '-------------------------------------
    Function SSetContainsSet(ByRef ThisSet As String, ByRef OtherSet As String) As Byte
        'true if neither Set empty and all values in OtherSet are in ThisSet
        Register x As Long
        If SSetCount(ThisSet) And SSetCount(OtherSet) Then
            For x = 1 To SSetCount(OtherSet)
                If IsFalse SSetContains(ThisSet, SSetGet(OtherSet, x)) Then Exit Function
            Next x
            Function = 1
        End If
    End Function
    '-------------------------------------
    Function SSetContained(ByRef ThisSet As String, ByRef OtherSet As String) As Long
        'get number of items in OtherSet that are in ThisSet
        Register x As Long
        Local items As Long
        For x = 1 To SSetCount(OtherSet)
            If IsTrue SSetContains(ThisSet, SSetGet(OtherSet, x)) Then Incr items
        Next x
        Function = items
    End Function
    '-------------------------------------
    Function SSetNotContained(ByRef ThisSet As String, ByRef OtherSet As String) As Long
        'get number of items in OtherSet that aren't in ThisSet
        Register x As Long
        Local items As Long
        For x = 1 To SSetCount(OtherSet)
            If IsFalse SSetContains(ThisSet, SSetGet(OtherSet, x)) Then Incr items
        Next x
        Function = items
    End Function
    '-------------------------------------
    Function SSetEqual(ByRef ThisSet As String, ByRef OtherSet As String) As Byte
        'true if both Sets empty or both same size and contain same values
        If SSetCount(ThisSet) = 0 And SSetCount(OtherSet) = 0 Then
            Function = 1
        ElseIf SSetCount(ThisSet) = SSetCount(OtherSet) And SSetContained(ThisSet, OtherSet) = SSetCount(ThisSet) Then
            Function = 1
        End If
    End Function
    '-------------------------------------
    Function SSetSum(ByRef ThisSet As String, ByRef OtherSet As String) As String
        'return unique Set of values that are in either Set
        Local result As String
        SSetAddSet result, ThisSet
        SSetAddSet result, OtherSet
        Function = result
    End Function
    '-------------------------------------
    Function SSetDifference(ByRef ThisSet As String, ByRef OtherSet As String) As String
        'return values that are in ThisSet but not in OtherSet
        Local result As String
        SSetAddSet result, ThisSet
        SSetSubtractSet result, OtherSet
        Function = result
    End Function
    '-------------------------------------
    Function SSetCommon(ByRef ThisSet As String, ByRef OtherSet As String) As String
        'return unique Set of values that are common to both Sets
        Register x As Long
        Local result As String
        For x = 1 To SSetCount(ThisSet)
            If IsTrue SSetContains(OtherSet, SSetGet(ThisSet, x)) Then SSetAdd result, SSetGet(ThisSet, x)
        Next x
        For x = 1 To SSetCount(OtherSet)
            If IsTrue SSetContains(ThisSet, SSetGet(OtherSet, x)) Then SSetAdd result, SSetGet(OtherSet, x)
        Next x
        Function = result
    End Function
    '-------------------------------------
    Function SSetUncommon(ByRef ThisSet As String, ByRef OtherSet As String) As String
        'return unique Set of values that are uncommon to both Sets
        Register x As Long
        Local result As String
        For x = 1 To SSetCount(ThisSet)
            If IsFalse SSetContains(OtherSet, SSetGet(ThisSet, x)) Then SSetAdd result, SSetGet(ThisSet, x)
        Next x
        For x = 1 To SSetCount(OtherSet)
            If IsFalse SSetContains(ThisSet, SSetGet(OtherSet, x)) Then SSetAdd result, SSetGet(OtherSet, x)
        Next x
        Function = result
    End Function
    '-------------------------------------
    Function SSetCommonCount(ByRef ThisSet As String, ByRef OtherSet As String) As Long
        'get number of values common to both Sets
        Local temp As String
        temp = SSetCommon(ThisSet, OtherSet)
        Function = SSetCount(temp)
    End Function
    '-------------------------------------
    Function SSetUncommonCount(ByRef ThisSet As String, ByRef OtherSet As String) As Long
        'get number of values uncommon to both Sets
        Local temp As String
        temp = SSetUncommon(ThisSet, OtherSet)
        Function = SSetCount(temp)
    End Function
    '-------------------------------------
#EndIf '%SSet230905


#If Not %Def(%FileUtilities230424)
    %FileUtilities230424 = 1
    ' File Utilities
    Sub StrToFile(ByRef file As WString, ByRef value As String)
        'store string to File
        Local f As Long
        If Len(file) = 0 Then Exit Sub
        f = FreeFile
        Open file For Binary As f
        SetEof f
        Put$ f, value
        Close f
    End Sub
    Function StrFromFile(ByRef file As WString) As String
        'get file contents as string
        Local f As Long
        Local value As String
        If IsFalse IsFile(file) Then Exit Function
        f = FreeFile
        Open file For Binary As f
        Get$ f, Lof(f), value
        Function = value
        Close f
    End Function
    Function StrFromFileFixed(ByRef file As WString) As String
        'get file contents converted from Unix line endings if any
        Local value As String
        value = StrFromFile(file)
        Replace $CrLf With $Lf In value
        Replace $CrLf With $Lf In value
        Replace $Cr With $Lf In value
        Replace $Cr With $Lf In value
        Replace $Lf With $CrLf In value
        Function = value
    End Function
    Sub WStrToFile(ByRef file As WString, ByRef value As WString)
        'store string to File
        Local f As Long
        If Len(file) = 0 Then Exit Sub
        f = FreeFile
        Open file For Binary As f
        SetEof f
        Put$$ f, value
        Close f
    End Sub
    Function WStrFromFile(ByRef file As WString) As WString
        'get file contents as string
        Local f As Long
        Local value As WString
        If IsFalse IsFile(file) Then Exit Function
        f = FreeFile
        Open file For Binary As f
        Get$$ f, Lof(f), value
        Function = value
        Close f
    End Function
    Sub WStrToTextFile(ByRef file As WString, ByRef value As WString)
        'store string converted to UTF8 to File
        StrToFile file, ChrToUtf8$(value)
    End Sub
    Function WStrFromTextFile(ByRef file As WString) As WString
        'get file contents converted from UTF8
        Function = Utf8ToChr$(StrFromFile(file))
    End Function
    Function WStrFromTextFileFixed(ByRef file As WString) As WString
        'get file contents converted from UTF8 fixing Unix line endings if any
        Local value As WString
        value = Utf8ToChr$(StrFromFile(file))
        Replace $CrLf With $Lf In value
        Replace $CrLf With $Lf In value
        Replace $Cr With $Lf In value
        Replace $Cr With $Lf In value
        Replace $Lf With $CrLf In value
        Function = value
    End Function
#EndIf '%FileUtilities230424�


Source:Powerbasic Forum
Print
Go Up Pages1
User actions