05.10.2025, 10:17 AM
Code:
'WStrList.inc
'Public domain, use at own risk. SDurham
'Function WStrListNew() As Long
'allocate new instance : return container pointer : call PtrFree(p) to free pointer
'Sub WStrListClear(ByVal p As WStrListT Ptr)
'empty container
'Function WStrListCount(ByVal p As WStrListT Ptr) As Long
'get item count
'Sub WStrListAdd(ByVal p As WStrListT Ptr, ByRef value As WString)
'append value
'Function WStrListCursor(ByVal p As WStrListT Ptr) As Long
'true/false if cursor valid
'Function WStrListFirst(ByVal p As WStrListT Ptr) As Long
'move cursor to first node : true/false success
'Function WStrListNext(ByVal p As WStrListT Ptr) As Long
'move cursor to next node : true/false success
'Function WStrListLast(ByVal p As WStrListT Ptr) As Long
'move cursor to last node : true/false success
'Function WStrListPervious(ByVal p As WStrListT Ptr) As Long
'move cursor to previous node : true/false success
'Function WStrListRember(ByVal p As WStrListT Ptr) As Long
'remember cursor position : fail if cursor null : true/false success
'Function WStrListReturn(ByVal p As WStrListT Ptr) As Long
'return to remembered position : fail if node deleted : true/false success
'Function WStrListGet(ByVal p As WStrListT Ptr) As WString
'get value at cursor position : null if cursor null
'Function WStrListSet(ByVal p As WStrListT Ptr, ByRef value As WString) As Long
'set value at cursor position : fail if cursor null : true/false success
'Function WStrListDeleteForward(ByVal p As WStrListT Ptr) As Long
'move to next node and delete node at cursor position : fail if cursor null : true/false success
'cursor will be null if no next node
'Function WStrListDeleteBackward(ByVal p As WStrListT Ptr) As Long
'move to previous node and delete node at cursor position : fail if cursor null : true/false success
'cursor will be null if no previous node
'Function WStrListIsBefore(ByVal p As WStrListT Ptr) As Long
'true/false if there is a node before cursor position
'Function WStrListIsAfter(ByVal p As WStrListT Ptr) As Long
'true/false if there is a node after cursor position
'Function WStrListDeleteBefore(ByVal p As WStrListT Ptr) As Long
'delete node before cursor position : fail if cursor null or no previous node : true/false success
'Function WStrListDeleteAfter(ByVal p As WStrListT Ptr) As Long
'delete node after cursor position : fail if cursor null or no next node : true/false success
'Function WStrListPushBefore(ByVal p As WStrListT Ptr, ByRef value As WString) As Long
'add value before cursor position : fail if cursor null : true/false success
'Function WStrListPushAfter(ByVal p As WStrListT Ptr, ByRef value As WString) As Long
'add value after cursor position : fail if cursor null : true/false success
'add value before cursor position : fail if cursor null : true/false success
'Function WStrListPeekBefore(ByVal p As WStrListT Ptr) As WString
'get value before cursor position : null if cursor invalid or no previous node
'Function WStrListPeekAfter(ByVal p As WStrListT Ptr) As WString
'get value after cursor position : null if cursor invalid or no next node
'Function WStrListPopBefore(ByVal p As WStrListT Ptr) As WString
'get and remove value before cursor position : null if cursor invalid or no previous node
'Function WStrListPopAfter(ByVal p As WStrListT Ptr) As WString
'get and remove value after cursor position : null if cursor invalid or no next node
'Sub WStrListPushFirst(ByVal p As WStrListT Ptr, ByRef value As WString)
'insert at front
'Sub WStrListPushLast(ByVal p As WStrListT Ptr, ByRef value As WString)
'append to end
'Function WStrListPeekFirst(ByVal p As WStrListT Ptr) As WString
'get fist value : null if list empty
'Function WStrListPeekLast(ByVal p As WStrListT Ptr) As WString
'get last value : null list empty
'Function WStrListPopFirst(ByVal p As WStrListT Ptr) As WString
'get and remove fist value : null if list empty
'Function WStrListPopLast(ByVal p As WStrListT Ptr) As WString
'get and remove last value : null if list empty
'Sub WStrListImport(ByVal p As WStrListT Ptr, a() As WString)
'import PB array
'Sub WStrListExport(ByVal p As WStrListT Ptr, a() As WString)
'export to PB array
'Sub WStrListSplit(ByVal p As WStrListT Ptr, ByVal delimited As WString, ByVal delimiter As WString)
'split array on delimited string
'Function WStrListJoin(ByVal p As WStrListT Ptr, ByVal delimiter As WString) As WString
'join array on delimiter
'Sub WStrListToText(ByVal p As WStrListT Ptr, ByVal file As WString)
'store list as text file converted to UTF8
'Sub WStrListFromText(ByVal p As WStrListT Ptr, ByVal file As WString)
'load text file converted from UTF8
'Sub WStrListFolders(ByVal p As WStrListT Ptr, ByVal rootFolder As WString)
'get all folders in root folder
'Sub WStrListFiles(ByVal p As WStrListT Ptr, ByVal folder As WString, ByVal mask As WString)
'get all files in folder matching mask
'Sub WStrListAllFolders(ByVal p As WStrListT Ptr, ByVal rootFolder As WString)
'get all folders in root folder and sub-folders, including root folder
'Sub WStrListAllFiles(ByVal p As WStrListT Ptr, ByVal rootFolder As WString, ByVal mask As WString)
'get all files in root folder, and sub-folders, matching mask
'Function WStrListStore(ByVal p As WStrListT Ptr) As String
'store container to String
'Sub WStrListRestore(ByVal p As WStrListT Ptr, ByRef stored As String)
'restore container from String
'Sub WStrListFileStore(ByVal p As WStrListT Ptr, ByVal file As WString)
'store container to File
'Sub WStrListFileRestore(ByVal p As WStrListT Ptr, ByVal file As WString)
'restore container from File
#If Not %Def(%ExitIf240526)
%ExitIf240526 = 1
'----------------------------------------------------------------------
'Error Exit Macro
'Exit procedure with error message
'if %LogOnError defined then errors logged to app folder
'if %MessageOnError defined then message on error
'if %HaltOnError defined then app halt with message on error
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
%ExitIfErr = 151
'----------------------------------------------------------------------
Macro ExitIf(test, message, exitWhat)
If test Then
ExitLog FuncName$ + "() " + message
Error %ExitIfErr
Exit exitWhat
End If
End Macro
Macro ExitF(test, message) = ExitIf(test, message, Function)
Macro ExitS(test, message) = ExitIf(test, message, Sub)
Macro ExitM(test, message) = ExitIf(test, message, Method)
Macro ExitP(test, message) = ExitIf(test, message, Property)
Macro ExitMC(test, message) = ExitIf(test, message, Macro)
'GoTo with error message
Macro GoToIf(test, message, goWhere)
If test Then
ExitLog FuncName$ +": "+ message
Error %ExitIfErr
GoTo goWhere
End If
End Macro
'----------------------------------------------------------------------
Sub ExitLog(ByVal message As String) Private
Local h As Long
h = FreeFile
#If %Def(%LogOnError) Or %Def(%MessageOnError) Or %Def(%HaltOnError)
Open Exe.Path$+"Error.log" For Append As h
If Lof(h) < 16000 Then
Print# h, Date$ +", "+ Time$ +", "+ Exe.Full$ +", "+ message
End If
Close h
#EndIf
#If %Def(%MessageOnError) Or %Def(%HaltOnError)
? message,,"Error!"
#EndIf
#If %Def(%HaltOnError)
End
#EndIf
End Sub
'----------------------------------------------------------------------
#EndIf '%ExitIf240526
#If Not %Def(%Memory230925)
%Memory230925 = 1
'----------------------------------------------------------------------
'Memory Allocation
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
Declare Function GlobalAlloc Lib "Kernel32.dll" Alias "GlobalAlloc" (ByVal uFlags As Dword, ByVal dwBytes As Dword) As Dword
Declare Function GlobalReAlloc Lib "Kernel32.dll" Alias "GlobalReAlloc" (ByVal hMem As Dword, ByVal dwBytes As Dword, ByVal uFlags As Dword) As Dword
Declare Function GlobalFree Lib "Kernel32.dll" Alias "GlobalFree" (ByVal hMem As Dword) As Dword
%MEMFIXED = &H0000 : %MEMMOVEABLE = &H0002 : %MEMZEROINIT = &H0040 : %MEMGPTR = (%MEMZEROINIT Or %MEMFIXED)
'----------------------------------------------------------------------
Function MemAlloc(ByVal bytes As Long) As Long
'allocate memory
If bytes Then Function = GlobalAlloc(ByVal %MEMGPTR, ByVal bytes)
End Function
'----------------------------------------------------------------------
Function MemReAlloc(ByVal hMem As Long, ByVal bytes As Long) As Long
'reallocate new size
If hMem And bytes Then
Function = GlobalReAlloc(ByVal hMem, ByVal bytes, ByVal %MEMMOVEABLE Or %MEMZEROINIT)
ElseIf bytes Then
Function = GlobalAlloc(ByVal %MEMGPTR, ByVal bytes)
ElseIf hMem Then
Function = GlobalFree(ByVal hMem)
End If
End Function
'----------------------------------------------------------------------
Function MemFree(ByVal hMem As Long) As Long
'free memory
If hMem Then GlobalFree(ByVal hMem)
End Function
'----------------------------------------------------------------------
#EndIf '%Memory230925
#If Not %Def(%Ptr250717)
%Ptr250717 = 1
'----------------------------------------------------------------------
'Allocate UDT Pointer
'PtrT must be first item in UDT
'call PtrNew() to allocate pointer
'call PtrFree() to free pointer
'if PtrNewCallback() supplied then called after memory allocated
'if PtrFinalCallback() supplied then called before memory freed
'instance count supported but shouldn't be used unless needed
'should be made clear who is responsible for freeing pointer
'----------------------------------------------------------------------
Declare Sub PtrNewCallback(ByVal p As Long)
'if supplied then called after ponter allocated
Declare Sub PtrFinalCallback(ByVal p As Long)
'if supplied then called before ponter freed
Declare Function PtrStoreCallback(ByVal p As Long) As String
'return String holding pointer's associated data
Declare Function PtrRestorCallback(ByRef stored As String) As Long
'return new instance with data restored
'----------------------------------------------------------------------
%PtrTag = 648910727
Type PtrT
tag As Long
instances As Long
finalCB As Long
End Type
'----------------------------------------------------------------------
Function PtrNew(ByVal SizeOfUdt As Long, ByVal newCB As Long, ByVal finalCB As Long) As Long
'allocate new pointer instance : return pointer
'if new callback supplied then called after memory allocated
'if final callback supplied then called before memory freed
Local p As PtrT Ptr
ExitF(SizeOfUdt < SizeOf(PtrT), "invalid size")
p = MemAlloc(SizeOfUdt)
If p Then
@p.tag = %PtrTag
@p.instances = 1
@p.finalCB = finalCB
If newCB Then Call Dword newCB Using PtrNewCallback(p)
Function = p
End If
End Function
'----------------------------------------------------------------------
Function PtrFree(ByVal p As PtrT Ptr) As Long
'free pointer allocated by PtrNew() : return null
'if final callback was supplied then called before memory freed
If p Then
ExitF(@p.tag <> %PtrTag, "invalid ptr")
ExitF(@p.instances < 1, "invalid instance count")
Decr @p.instances
If @p.instances = 0 Then
If @p.finalCB Then Call Dword @p.finalCB Using PtrFinalCallback(p)
MemFree(p)
End If
End If
End Function
'----------------------------------------------------------------------
Sub PtrIncr(ByVal p As PtrT Ptr)
'increment instance count
ExitS(p = 0 Or @p.tag <> %PtrTag, "invalid ptr")
Incr @p.instances
End Sub
'----------------------------------------------------------------------
#EndIf '%Ptr250717
#If Not %Def(%StrBuild250811)
%StrBuild250811 = 1
'----------------------------------------------------------------------
'String Builder
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
%BytSize = 1
%StrBuildBufferMax = 5000000
'----------------------------------------------------------------------
Type StrBuildT
mem As Long
count As Long
max As Long
End Type
'----------------------------------------------------------------------
Sub StrBuildPush(t As StrBuildT, ByVal value As String)
'append value
Local strlen, currentcount, buffer, newmax As Long
strlen = Len(value)
If strlen Then
If strlen > t.max - t.count Then
currentcount = t.count : t.count = 0 : t.max = 0
buffer = Max&(1, 2 * currentcount)
buffer = Min&(buffer, %StrBuildBufferMax)
newmax = currentcount + buffer + strlen
t.mem = MemReAlloc(t.mem, newmax * %BytSize)
If t.mem = 0 Then Exit Sub
t.count = currentcount : t.max = newmax
End If
Memory Copy StrPtr(value), t.mem + (t.count * %BytSize), strlen * %BytSize
t.count += strlen
End If
End Sub
'----------------------------------------------------------------------
Function StrBuildPop(t As StrBuildT) As String
'get whole string : free memory
If t.mem And t.count Then Function = Peek$(t.mem, t.count)
t.mem = MemFree(t.mem)
t.count = 0
t.max = 0
End Function
'----------------------------------------------------------------------
#EndIf '%StrBuild250811
#If Not %Def(%FileStore250717)
%FileStore250717 = 1
Sub FilePut(ByVal file As WString, ByRef value As WString)
'store value 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 FileGet(ByRef file As WString) As WString
'restore value from File
Local f As Long, value As WString
If IsFalse IsFile(file) Then Exit Function
f = FreeFile
Open file For Binary As f
Get$ f, Lof(f), value
Close f
Function = value
End Function
#EndIf '%FileStore250717
#If Not %Def(%PtrList250812)
%PtrList250812 = 1
'----------------------------------------------------------------------
'Pointer Doubly Linked List : Stack : Queue : Deque
'pointers to allocated UDTs
'PtrT must be first item in UDT
'pointer must have been allocated with PtrNew()
'stored pointers can't be null
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
Declare Function PtrStoreCallback(ByVal p As Long) As String
'return String holding pointer's associated data
Declare Function PtrRestorCallback(ByRef stored As String) As Long
'return new instance with data restored
'----------------------------------------------------------------------
%LngSize = 4
%PtrListTag = -699621965
Type PtrListNodeT
allocator As PtrT
next As PtrListNodeT Ptr
prev As PtrListNodeT Ptr
value As Long
End Type
Type PtrListT
allocator As PtrT
tag As Long
count As Long
first As PtrListNodeT Ptr
last As PtrListNodeT Ptr
cursor As PtrListNodeT Ptr
remember As PtrListNodeT Ptr
End Type
'----------------------------------------------------------------------
Function PtrListNew() As Long
'allocate new instance : return container pointer : call PtrFree(p) to free pointer
Function = PtrNew(SizeOf(PtrListT), CodePtr(PtrListNewCB), CodePtr(PtrListClear))
End Function
'----------------------------------------------------------------------
Sub PtrListClear(ByVal p As PtrListT Ptr)
'empty container
Local node As PtrListNodeT Ptr
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
While @p.first
node = @p.first
@p.first = @node.next
PtrFree(node)
Wend
@p.last = 0
@p.count = 0
@p.cursor = 0
@p.remember = 0
End Sub
'----------------------------------------------------------------------
Function PtrListCount(ByVal p As PtrListT Ptr) As Long
'get item count
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
Function = @p.count
End Function
'----------------------------------------------------------------------
Sub PtrListAdd(ByVal p As PtrListT Ptr, ByVal pItem As Long)
'append value
PtrListPushLast p, pItem
End Sub
'----------------------------------------------------------------------
Function PtrListCursor(ByVal p As PtrListT Ptr) As Long
'true/false if cursor valid
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListFirst(ByVal p As PtrListT Ptr) As Long
'move cursor to first node : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
@p.cursor = @p.first
If @p.cursor Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListNext(ByVal p As PtrListT Ptr) As Long
'move cursor to next node : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor Then @p.cursor = @p.@cursor.next
If @p.cursor Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListLast(ByVal p As PtrListT Ptr) As Long
'move cursor to last node : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
@p.cursor = @p.last
If @p.cursor Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListPervious(ByVal p As PtrListT Ptr) As Long
'move cursor to previous node : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor Then @p.cursor = @p.@cursor.prev
If @p.cursor Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListRember(ByVal p As PtrListT Ptr) As Long
'remember cursor position : fail if cursor null : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
@p.remember = @p.cursor
If @p.remember Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListReturn(ByVal p As PtrListT Ptr) As Long
'return to remembered position : fail if node deleted : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
@p.cursor = @p.remember
If @p.cursor Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListGet(ByVal p As PtrListT Ptr) As Long
'get value at cursor position : null if cursor null
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor Then Function = @p.@cursor.value
End Function
'----------------------------------------------------------------------
Function PtrListDeleteForward(ByVal p As PtrListT Ptr) As Long
'move to next node and delete node at cursor position : fail if cursor null : true/false success
'cursor will be null if no next node
Local n As PtrListNodeT Ptr
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor Then
Function = 1
n = @p.cursor
@p.cursor = @p.@cursor.next
PtrListNodeDelete(p, n)
End If
End Function
'----------------------------------------------------------------------
Function PtrListDeleteBackward(ByVal p As PtrListT Ptr) As Long
'move to previous node and delete node at cursor position : fail if cursor null : true/false success
'cursor will be null if no previous node
Local n As PtrListNodeT Ptr
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor Then
Function = 1
n = @p.cursor
@p.cursor = @p.@cursor.prev
PtrListNodeDelete(p, n)
End If
End Function
'----------------------------------------------------------------------
Function PtrListIsBefore(ByVal p As PtrListT Ptr) As Long
'true/false if there is a node before cursor position
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor And @p.@cursor.prev Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListIsAfter(ByVal p As PtrListT Ptr) As Long
'true/false if there is a node after cursor position
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor And @p.@cursor.next Then Function = 1
End Function
'----------------------------------------------------------------------
Function PtrListDeleteBefore(ByVal p As PtrListT Ptr) As Long
'delete node before cursor position : fail if cursor null or no previous node : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor And @p.@cursor.prev Then
PtrListNodeDelete p, @p.@cursor.prev
Function = 1
End If
End Function
'----------------------------------------------------------------------
Function PtrListDeleteAfter(ByVal p As PtrListT Ptr) As Long
'delete node after cursor position : fail if cursor null or no next node : true/false success
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor And @p.@cursor.next Then
PtrListNodeDelete p, @p.@cursor.next
Function = 1
End If
End Function
'----------------------------------------------------------------------
Function PtrListPushBefore(ByVal p As PtrListT Ptr, ByVal pItem As Long) As Long
'add value before cursor position : fail if cursor null : true/false success
Local node As PtrListNodeT Ptr
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitF(pItem = 0 Or Peek(Long, pItem) <> %PtrTag, "invalid item")
If @p.cursor Then
Function = 1
If @p.cursor = @p.first Then
PtrListPushFirst p, pItem
Else
ExitF(@p.@cursor.prev = 0, "previous node null")
node = PtrNew(SizeOf(PtrListNodeT), 0, CodePtr(PtrListNodeFinalCB))
ExitF(node = 0, "PtrNew fail")
@node.value = pItem
@node.next = @p.cursor
@node.prev = @p.@cursor.prev
@p.@cursor.@prev.next = node
@p.@cursor.prev = node
End If
End If
End Function
'----------------------------------------------------------------------
Function PtrListPushAfter(ByVal p As PtrListT Ptr, ByVal pItem As Long) As Long
'add value after cursor position : fail if cursor null : true/false success
Local node As PtrListNodeT Ptr
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitF(pItem = 0 Or Peek(Long, pItem) <> %PtrTag, "invalid item")
If @p.cursor Then
Function = 1
If @p.cursor = @p.last Then
PtrListPushLast p, pItem
Else
ExitF(@p.@cursor.next = 0, "next node null")
node = PtrNew(SizeOf(PtrListNodeT), 0, CodePtr(PtrListNodeFinalCB))
ExitF(node = 0, "PtrNew fail")
@node.value = pItem
@node.prev = @p.cursor
@node.next = @p.@cursor.next
@p.@cursor.@next.prev = node
@p.@cursor.next = node
End If
End If
End Function
'----------------------------------------------------------------------
Function PtrListPeekBefore(ByVal p As PtrListT Ptr) As Long
'get value before cursor position : null if cursor invalid or no previous node
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor And @p.@cursor.prev Then Function = @p.@cursor.@prev.value
End Function
'----------------------------------------------------------------------
Function PtrListPeekAfter(ByVal p As PtrListT Ptr) As Long
'get value after cursor position : null if cursor invalid or no next node
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.cursor And @p.@cursor.next Then Function = @p.@cursor.@next.value
End Function
'----------------------------------------------------------------------
Function PtrListPopBefore(ByVal p As PtrListT Ptr) As Long
'get and remove value before cursor position : null if cursor invalid or no previous node
'user responsible for freeing popped pointers
Local h As Long
h = PtrListPeekBefore(p)
If h Then
PtrIncr(h)
Function = h
PtrListDeleteBefore(p)
End If
End Function
'----------------------------------------------------------------------
Function PtrListPopAfter(ByVal p As PtrListT Ptr) As Long
'get and remove value after cursor position : null if cursor invalid or no next node
'user responsible for freeing popped pointers
Local h As Long
h = PtrListPeekAfter(p)
If h Then
PtrIncr(h)
Function = h
PtrListDeleteAfter(p)
End If
End Function
'----------------------------------------------------------------------
Sub PtrListPushFirst(ByVal p As PtrListT Ptr, ByVal pItem As Long)
'insert at front
Local node As PtrListNodeT Ptr
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitS(pItem = 0 Or Peek(Long, pItem) <> %PtrTag, "invalid item")
node = PtrNew(SizeOf(PtrListNodeT), 0, CodePtr(PtrListNodeFinalCB))
ExitS(node = 0, "PtrNew fail")
@node.value = pItem
If @p.count Then
ExitS(@p.first = 0, "first node null")
@p.@first.prev = node
@node.next = @p.first
@p.first = node
Incr @p.count
Else
@p.first = node
@p.last = node
@p.count = 1
End If
End Sub
'----------------------------------------------------------------------
Sub PtrListPushLast(ByVal p As PtrListT Ptr, ByVal pItem As Long)
'append to end
Local node As PtrListNodeT Ptr
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitS(pItem = 0 Or Peek(Long, pItem) <> %PtrTag, "invalid item")
node = PtrNew(SizeOf(PtrListNodeT), 0, CodePtr(PtrListNodeFinalCB))
ExitS(node = 0, "PtrNew fail")
@node.value = pItem
If @p.count Then
ExitS(@p.last = 0, "last node null")
@p.@last.next = node
@node.prev = @p.last
@p.last = node
Incr @p.count
Else
@p.first = node
@p.last = node
@p.count = 1
End If
End Sub
'----------------------------------------------------------------------
Function PtrListPeekFirst(ByVal p As PtrListT Ptr) As Long
'get fist value : null if list empty
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.first Then Function = @p.@first.value
End Function
'----------------------------------------------------------------------
Function PtrListPeekLast(ByVal p As PtrListT Ptr) As Long
'get last value : null list empty
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.last Then Function = @p.@last.value
End Function
'----------------------------------------------------------------------
Function PtrListPopFirst(ByVal p As PtrListT Ptr) As Long
'get and remove fist value : null if list empty
'user responsible for freeing popped pointers
Local h As Long
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.first Then
h = @p.@first.value
PtrIncr(h)
Function = h
PtrListNodeDelete(p, @p.first)
End If
End Function
'----------------------------------------------------------------------
Function PtrListPopLast(ByVal p As PtrListT Ptr) As Long
'get and remove last value : null if list empty
'user responsible for freeing popped pointers
Local h As Long
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
If @p.last Then
h = @p.@last.value
PtrIncr(h)
Function = h
PtrListNodeDelete(p, @p.last)
End If
End Function
'----------------------------------------------------------------------
Function PtrListStore(ByVal p As PtrListT Ptr, ByVal storeCB As Long) As String
'store container to String
'Declare Function PtrStoreCallback(ByVal p As Long) As String
Local more, h As Long
Local sb As StrBuildT
Local s As String
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitF(storeCB = 0, "null callback")
If @p.count Then
StrBuildPush sb, Mkl$(@p.count)
more = PtrListFirst(p)
While more
h = PtrListGet(p)
ExitF(h = 0, "unexpected null")
Call Dword storeCB Using PtrStoreCallback(h) To s
StrBuildPush sb, Mkl$(Len(s))
StrBuildPush sb, s
more = PtrListNext(p)
Wend
End If
Function = StrBuildPop(sb)
End Function
'----------------------------------------------------------------------
Sub PtrListRestore(ByVal p As PtrListT Ptr, ByRef stored As String, ByVal restoreCB As Long)
'restore container from String
'Declare Function PtrRestorCallback(ByRef stored As String) As Long
Register i As Long
Local items, bytes, h As Long
Local s As String
Local pl As Long Ptr
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitS(restoreCB = 0, "null callback")
PtrListClear p
If Len(stored) Then
pl = StrPtr(stored)
items = @pl : Incr pl
For i = 1 To items
bytes = @pl : Incr pl
s = Peek$(pl, bytes) : pl += bytes
Call Dword restoreCB Using PtrRestorCallback(s) To h
ExitS(h = 0,"null callback return")
PtrListAdd p, h
Next i
End If
End Sub
'----------------------------------------------------------------------
Sub PtrListFileStore(ByVal p As PtrListT Ptr, ByVal file As WString, ByVal storeCB As Long)
'store container to File
'Declare Function PtrStoreCallback(ByVal p As Long) As String
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitS(storeCB = 0, "null callback")
ExitS(Len(file) = 0, "invalid file")
FilePut file, PtrListStore(p, storeCB)
End Sub
'----------------------------------------------------------------------
Sub PtrListFileRestore(ByVal p As PtrListT Ptr, ByVal file As WString, ByVal restoreCB As Long)
'restore container from File
'Declare Function PtrRestorCallback(ByRef stored As String) As Long
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %PtrListTag, "invalid ptr")
ExitS(IsFalse IsFile(file), "invalid file" + file)
PtrListRestore p, FileGet(file), restoreCB
End Sub
'----------------------------------------------------------------------
'PRIVATE:
'----------------------------------------------------------------------
Sub PtrListNewCB(ByVal p As PtrListT Ptr) Private
'PRIVATE: list new callback
If p Then @p.tag = %PtrListTag
End Sub
'----------------------------------------------------------------------
Sub PtrListNodeFinalCB(ByVal node As PtrListNodeT Ptr)
If node Then
PtrFree(@node.value)
End If
End Sub
'----------------------------------------------------------------------
Sub PtrListNodeDelete(ByVal p As PtrListT Ptr, ByVal node As PtrListNodeT Ptr) Private
'PRIVATE: remove node from list
If node Then
If @p.cursor = node Then @p.cursor = 0
If @p.remember = node Then @p.remember = 0
If @p.first = node Then @p.first = @node.next
If @p.last = node Then @p.last = @node.prev
If @node.prev Then @node.@prev.next = @node.next
If @node.next Then @node.@next.prev = @node.prev
ExitS(@p.count = 0, "invalid count")
Decr @p.count
PtrFree(node)
End If
End Sub
'----------------------------------------------------------------------
#EndIf '%PtrList250812
#If Not %Def(%WStr250724)
%WStr250724 = 1
'----------------------------------------------------------------------
'Dynamic WString Container
'----------------------------------------------------------------------
Declare Function WStrCompareCallback(ByVal a As Long, ByVal b As Long) As Long
'a < b : return < 0 a = b : return = 0 a > b : return > 0
'----------------------------------------------------------------------
%WrdSize = 2
%WStrTag = -1731001151
Type WStrT
allocator As PtrT
tag As Long
mem As Word Ptr
count As Long
End Type
'----------------------------------------------------------------------
Function WStrNew() As Long
'allocate new instance : return container pointer : call PtrFree(p) to free pointer
Function = PtrNew(SizeOf(WStrT), CodePtr(WStrNewCB), CodePtr(WStrClear))
End Function
'----------------------------------------------------------------------
Sub WStrClear(ByVal p As WStrT Ptr)
'empty container
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %WStrTag, "invalid ptr")
@p.mem = MemFree(@p.mem)
@p.count = 0
End Sub
'----------------------------------------------------------------------
Function WStrGet(ByVal p As WStrT Ptr) As WString
'get value
ExitF(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %WStrTag, "invalid ptr")
Function = Peek$$(@p.mem, @p.count)
End Function
'----------------------------------------------------------------------
Macro WStrGetM(p) = IIf$(p, Peek$$(@p.mem, @p.count,), "")
'----------------------------------------------------------------------
Sub WStrSet(ByVal p As WStrT Ptr, ByRef value As WString)
Local strlen As Long : strlen = Len(value)
Local bytes As Long : bytes = strlen * %WrdSize
ExitS(p = 0 Or @p.allocator.tag <> %PtrTag Or @p.tag <> %WStrTag, "invalid ptr")
@p.mem = MemFree(@p.mem) : @p.count = 0
If strlen Then
@p.mem = MemAlloc(bytes)
If @p.mem Then
@p.count = strlen
Memory Copy StrPtr(value), @p.mem, bytes
End If
End If
End Sub
'----------------------------------------------------------------------
Function WStrNewValue(ByRef value As WString) As Long
'allocate new instance : store value : return pointer
Local h As Long
h = WStrNew()
WStrSet h, value
Function = h
End Function
'----------------------------------------------------------------------
Function WStrHashIndex(ByVal p As WStrT Ptr, ByVal capacity As Long) As Long
'get key's one-based hash index position
Register i As Long : Local total, temp As Long
Function = 1
If p Then
For i = 0 To @p.count - 1
temp += @p.@mem[i] + total
Shift Left total, 8
total += temp
Next i
Function = Abs(total Mod capacity) + 1
End If
End Function
'----------------------------------------------------------------------
Function WStrEqual(ByVal a As WStrT Ptr, ByVal b As WStrT Ptr) As Long
'true/false if two strings equal
Register i As Long
If a And b And @a.count = @b.count Then
For i = 0 To @a.count - 1
If @a.@mem[i] <> @b.@mem[i] Then Exit Function
Next i
Function = 1
End If
End Function
'----------------------------------------------------------------------
Function WStrCompare(ByVal a As WStrT Ptr, ByVal b As WStrT Ptr) As Long
'compare callback : case sensitive
Register i As Long : Register compare As Long
If a And b Then
For i = 0 To Min&(@a.count, @b.count) - 1
compare = @a.@mem[i] - @b.@mem[i]
If compare Then
Function = compare : Exit Function
End If
Next i
Function = @a.count - @b.count
End If
End Function
'----------------------------------------------------------------------
Function WStrCompareIgnore(ByVal a As WStrT Ptr, ByVal b As WStrT Ptr) As Long
'compare callback : case sensitive
Register i As Long : Register compare As Long : Local la, lb As Long
If a And b Then
For i = 0 To Min&(@a.count, @b.count) - 1
la = @a.@mem[i] : lb = @b.@mem[i]
If la > 64 And la < 91 Then la += 32
If lb > 64 And lb < 91 Then lb += 32
compare = la - lb
If compare Then
Function = compare : Exit Function
End If
Next i
Function = @a.count - @b.count
End If
End Function
'----------------------------------------------------------------------
Function WStrStoreCB(ByVal p As WStrT Ptr) As String
'store callback
Function = ChrToUtf8$(WStrGet(p))
End Function
'----------------------------------------------------------------------
Function WStrRestoreCB(ByRef value As String) As Long
'restore callback
Function = WStrNewValue(Utf8ToChr$(value))
End Function
'----------------------------------------------------------------------
'PRIVATE:
'----------------------------------------------------------------------
Sub WStrNewCB(ByVal p As WStrT Ptr) Private
'PRIVATE: new callback
If p Then @p.tag = %WStrTag
End Sub
'----------------------------------------------------------------------
#EndIf '%WStr250724
#If Not %Def(%WStrList250812)
%WStrList250812 = 1
'----------------------------------------------------------------------
'WString Doubly Linked List : Stack : Queue : Deque
'----------------------------------------------------------------------
Macro WStrListT = PtrListT
'----------------------------------------------------------------------
Function WStrListNew() As Long
'allocate new instance : return container pointer : call PtrFree(p) to free pointer
Function = PtrListNew()
End Function
'----------------------------------------------------------------------
Sub WStrListClear(ByVal p As WStrListT Ptr)
'empty container
PtrListClear p
End Sub
'----------------------------------------------------------------------
Function WStrListCount(ByVal p As WStrListT Ptr) As Long
'get item count
Function = PtrListCount(p)
End Function
'----------------------------------------------------------------------
Sub WStrListAdd(ByVal p As WStrListT Ptr, ByRef value As WString)
'append value
PtrListAdd p, WStrNewValue(value)
End Sub
'----------------------------------------------------------------------
Function WStrListCursor(ByVal p As WStrListT Ptr) As Long
'true/false if cursor valid
Function = PtrListCursor(p)
End Function
'----------------------------------------------------------------------
Function WStrListFirst(ByVal p As WStrListT Ptr) As Long
'move cursor to first node : true/false success
Function = PtrListFirst(p)
End Function
'----------------------------------------------------------------------
Function WStrListNext(ByVal p As WStrListT Ptr) As Long
'move cursor to next node : true/false success
Function = PtrListNext(p)
End Function
'----------------------------------------------------------------------
Function WStrListLast(ByVal p As WStrListT Ptr) As Long
'move cursor to last node : true/false success
Function = PtrListLast(p)
End Function
'----------------------------------------------------------------------
Function WStrListPervious(ByVal p As WStrListT Ptr) As Long
'move cursor to previous node : true/false success
Function = PtrListPervious(p)
End Function
'----------------------------------------------------------------------
Function WStrListRember(ByVal p As WStrListT Ptr) As Long
'remember cursor position : fail if cursor null : true/false success
Function = PtrListRember(p)
End Function
'----------------------------------------------------------------------
Function WStrListReturn(ByVal p As WStrListT Ptr) As Long
'return to remembered position : fail if node deleted : true/false success
Function = PtrListReturn(p)
End Function
'----------------------------------------------------------------------
Function WStrListGet(ByVal p As WStrListT Ptr) As WString
'get value at cursor position : null if cursor null
Local h As Long
h = PtrListGet(p)
If h Then Function = WStrGet(h)
End Function
'----------------------------------------------------------------------
Function WStrListSet(ByVal p As WStrListT Ptr, ByRef value As WString) As Long
'set value at cursor position : fail if cursor null : true/false success
Local h As Long
h = PtrListGet(p)
If h Then
WStrSet h, value
Function = 1
End If
End Function
'----------------------------------------------------------------------
Function WStrListDeleteForward(ByVal p As WStrListT Ptr) As Long
'move to next node and delete node at cursor position : fail if cursor null : true/false success
'cursor will be null if no next node
Function = PtrListDeleteForward(p)
End Function
'----------------------------------------------------------------------
Function WStrListDeleteBackward(ByVal p As WStrListT Ptr) As Long
'move to previous node and delete node at cursor position : fail if cursor null : true/false success
'cursor will be null if no previous node
Function = PtrListDeleteBackward(p)
End Function
'----------------------------------------------------------------------
Function WStrListIsBefore(ByVal p As WStrListT Ptr) As Long
'true/false if there is a node before cursor position
Function = PtrListIsBefore(p)
End Function
'----------------------------------------------------------------------
Function WStrListIsAfter(ByVal p As WStrListT Ptr) As Long
'true/false if there is a node after cursor position
Function = PtrListIsAfter(p)
End Function
'----------------------------------------------------------------------
Function WStrListDeleteBefore(ByVal p As WStrListT Ptr) As Long
'delete node before cursor position : fail if cursor null or no previous node : true/false success
Function = PtrListDeleteBefore(p)
End Function
'----------------------------------------------------------------------
Function WStrListDeleteAfter(ByVal p As WStrListT Ptr) As Long
'delete node after cursor position : fail if cursor null or no next node : true/false success
Function = PtrListDeleteAfter(p)
End Function
'----------------------------------------------------------------------
Function WStrListPushBefore(ByVal p As WStrListT Ptr, ByRef value As WString) As Long
'add value before cursor position : fail if cursor null : true/false success
Local h As Long : h = WStrNewValue(value)
If IsFalse PtrListPushBefore(p, h) Then PtrFree(h)
End Function
'----------------------------------------------------------------------
Function WStrListPushAfter(ByVal p As WStrListT Ptr, ByRef value As WString) As Long
'add value after cursor position : fail if cursor null : true/false success
'add value before cursor position : fail if cursor null : true/false success
Local h As Long : h = WStrNewValue(value)
If IsFalse PtrListPushAfter(p, h) Then PtrFree(h)
End Function
'----------------------------------------------------------------------
Function WStrListPeekBefore(ByVal p As WStrListT Ptr) As WString
'get value before cursor position : null if cursor invalid or no previous node
Local h As Long : h = PtrListPeekBefore(p)
If h Then Function = WStrGet(h)
End Function
'----------------------------------------------------------------------
Function WStrListPeekAfter(ByVal p As WStrListT Ptr) As WString
'get value after cursor position : null if cursor invalid or no next node
Local h As Long : h = PtrListPeekAfter(p)
If h Then Function = WStrGet(h)
End Function
'----------------------------------------------------------------------
Function WStrListPopBefore(ByVal p As WStrListT Ptr) As WString
'get and remove value before cursor position : null if cursor invalid or no previous node
Local h As Long : h = PtrListPopBefore(p)
If h Then
Function = WStrGet(h)
PtrFree(h)
End If
End Function
'----------------------------------------------------------------------
Function WStrListPopAfter(ByVal p As WStrListT Ptr) As WString
'get and remove value after cursor position : null if cursor invalid or no next node
Local h As Long : h = PtrListPopAfter(p)
If h Then
Function = WStrGet(h)
PtrFree(h)
End If
End Function
'----------------------------------------------------------------------
Sub WStrListPushFirst(ByVal p As WStrListT Ptr, ByRef value As WString)
'insert at front
PtrListPushFirst p, WStrNewValue(value)
End Sub
'----------------------------------------------------------------------
Sub WStrListPushLast(ByVal p As WStrListT Ptr, ByRef value As WString)
'append to end
PtrListPushLast p, WStrNewValue(value)
End Sub
'----------------------------------------------------------------------
Function WStrListPeekFirst(ByVal p As WStrListT Ptr) As WString
'get fist value : null if list empty
Local h As Long : h = PtrListPeekFirst(p)
If h Then Function = WStrGet(h)
End Function
'----------------------------------------------------------------------
Function WStrListPeekLast(ByVal p As WStrListT Ptr) As WString
'get last value : null list empty
Local h As Long : h = PtrListPeekLast(p)
If h Then Function = WStrGet(h)
End Function
'----------------------------------------------------------------------
Function WStrListPopFirst(ByVal p As WStrListT Ptr) As WString
'get and remove fist value : null if list empty
Local h As Long : h = PtrListPopFirst(p)
If h Then
Function = WStrGet(h)
PtrFree(h)
End If
End Function
'----------------------------------------------------------------------
Function WStrListPopLast(ByVal p As WStrListT Ptr) As WString
'get and remove last value : null if list empty
Local h As Long : h = PtrListPopLast(p)
If h Then
Function = WStrGet(h)
PtrFree(h)
End If
End Function
'----------------------------------------------------------------------
Sub WStrListImport(ByVal p As WStrListT Ptr, a() As WString)
'import PB array
Register i As Long
WStrListClear p
For i = LBound(a) To UBound(a)
WStrListAdd p, a(i)
Next i
End Sub
'----------------------------------------------------------------------
Sub WStrListExport(ByVal p As WStrListT Ptr, a() As WString)
'export to PB array
Register i As Long
Local more As Long
Erase a()
If WStrListCount(p) Then
ReDim a(1 To WStrListCount(p))
more = WStrListFirst(p)
While more
Incr i
a(i) = WStrListGet(p)
more = WStrListNext(p)
Wend
End If
End Sub
'----------------------------------------------------------------------
Sub WStrListSplit(ByVal p As WStrListT Ptr, ByVal delimited As WString, ByVal delimiter As WString)
'split array on delimited string
Local items As Long
Local a() As WString
WStrListClear p
If Len(delimited) Then
items = ParseCount(delimited, delimiter)
If items Then
Dim a(1 To items)
Parse delimited, a(), delimiter
WStrListImport p, a()
End If
End If
End Sub
'----------------------------------------------------------------------
Function WStrListJoin(ByVal p As WStrListT Ptr, ByVal delimiter As WString) As WString
'join array on delimiter
Local a() As WString
WStrListExport p, a()
Function = Join$(a(), delimiter)
End Function
'----------------------------------------------------------------------
Sub WStrListToText(ByVal p As WStrListT Ptr, ByVal file As WString)
'store list as text file converted to UTF8
If WStrListCount(p) Then
FilePut file, ChrToUtf8$(RTrim$(WStrListJoin(p, $CrLf)) + $CrLf)
End If
End Sub
'----------------------------------------------------------------------
Sub WStrListFromText(ByVal p As WStrListT Ptr, ByVal file As WString)
'load text file converted from UTF8
Local contents As WString
WStrListClear p
contents = Utf8ToChr$(FileGet(file))
contents = Trim$(contents, $CrLf)
If Len(contents) Then
WStrListSplit p, contents, $CrLf
End If
End Sub
'----------------------------------------------------------------------
Sub WStrListFolders(ByVal p As WStrListT Ptr, ByVal rootFolder As WString)
'get all folders in root folder
Local folder, folderMask, rootPath As WString
Local DrD As DirData
WStrListClear p
ExitS(IsFalse IsFolder(rootFolder), "invalid folder")
rootPath = RTrim$(rootFolder, "\") + "\"
folderMask = rootPath
folder = Dir$(folderMask, Only %SubDir To DrD)
While Len(folder)
WStrListAdd p, rootPath + folder
folder = Dir$
Wend
End Sub
'----------------------------------------------------------------------
Sub WStrListFiles(ByVal p As WStrListT Ptr, ByVal folder As WString, ByVal mask As WString)
'get all files in folder matching mask
Local file, fileMask As WString
WStrListClear p
ExitS(IsFalse IsFolder(folder), "invalid folder")
folder = RTrim$(folder, "\") + "\"
fileMask = folder + mask
file = Dir$(fileMask)
While Len(file)
WStrListAdd p, folder + file
file = Dir$
Wend
End Sub
'----------------------------------------------------------------------
Sub WStrListAllFolders(ByVal p As WStrListT Ptr, ByVal rootFolder As WString)
'get all folders in root folder and sub-folders, including root folder
Local folderStack As Long : folderStack = WStrListNew()
Local subFolderStack As Long : subFolderStack = WStrListNew()
Local currentFolder As WString
WStrListClear p
ExitS(IsFalse IsFolder(rootFolder), "invalid folder")
WStrListPushLast folderStack, rootFolder
While WStrListCount(folderStack)
currentFolder = WStrListPopLast(folderStack)
WStrListAdd p, currentFolder
WStrListFolders subFolderStack, currentFolder
While WStrListCount(subFolderStack)
WStrListPushLast folderStack, WStrListPopLast(subFolderStack)
Wend
Wend
folderStack = PtrFree(folderStack)
subFolderStack = PtrFree(subFolderStack)
End Sub
'----------------------------------------------------------------------
Sub WStrListAllFiles(ByVal p As WStrListT Ptr, ByVal rootFolder As WString, ByVal mask As WString)
'get all files in root folder, and sub-folders, matching mask
Local allFolderStack As Long : allFolderStack = WStrListNew()
Local folderFileStack As Long : folderFileStack = WStrListNew()
WStrListClear p
ExitS(IsFalse IsFolder(rootFolder), "invalid folder")
WStrListAllFolders allFolderStack, rootFolder
While WStrListCount(allFolderStack)
WStrListFiles folderFileStack, WStrListPopLast(allFolderStack), mask
While WStrListCount(folderFileStack)
WStrListAdd p, WStrListPopLast(folderFileStack)
Wend
Wend
allFolderStack = PtrFree(allFolderStack)
folderFileStack = PtrFree(folderFileStack)
End Sub
'----------------------------------------------------------------------
Function WStrListStore(ByVal p As WStrListT Ptr) As String
'store container to String
Function = PtrListStore(p, CodePtr(WStrStoreCB))
End Function
'----------------------------------------------------------------------
Sub WStrListRestore(ByVal p As WStrListT Ptr, ByRef stored As String)
'restore container from String
PtrListRestore p, stored, CodePtr(WStrRestoreCB)
End Sub
'----------------------------------------------------------------------
Sub WStrListFileStore(ByVal p As WStrListT Ptr, ByVal file As WString)
'store container to File
PtrListFileStore p, file, CodePtr(WStrStoreCB)
End Sub
'----------------------------------------------------------------------
Sub WStrListFileRestore(ByVal p As WStrListT Ptr, ByVal file As WString)
'restore container from File
PtrListFileRestore p, file, CodePtr(WStrRestoreCB)
End Sub
'----------------------------------------------------------------------
#EndIf '%WStrList250812