data-structures and more

[ReneMiner]

since tB 1.9.16.x introduced data-structures as Hash & AVL-tree we have great opportunities to store our data and very fast access to it.

But for some cases as named and indexed objects, that need to be stored & accessed not by just one key and to have information about type of data it would be great to have some kind of database that allows to access stored objects by their name [& index] as common [array-] variables and be able to tell theirs Typename.

Stored objects might be controls for some GUI-project, entities or shapes to draw & render and lots more.

I currently use heap-memory and do all the management with a couple of comparison- & scan-methods
but i think this can be improved in execution-speed if we had something as this built-in.

Attached some example database-type which can store any data that mandatory Extends the same Dataheader,
all stored information will have 3 properties telling type, name and index.

Instead of controls, entities or shapes the example-script uses some "food"-type,
split into different subtypes as "meat" and "fruits" which have different properties.

I hope something as this could become a module or part of core-engine.



' #Filename "test_tDatabase.tbasic"
Uses "console"

#INCLUDE Once "tDatabase.tBasicU"

%brightYellow = %CONSOLE_FOREGROUND_GREEN | %CONSOLE_FOREGROUND_RED | %CONSOLE_FOREGROUND_INTENSITY
%brightPurple = %CONSOLE_FOREGROUND_BLUE | %CONSOLE_FOREGROUND_RED | %CONSOLE_FOREGROUND_INTENSITY


' we create a database for some food:


' #####################################################################
Type tFood Extends tDataheader
' #####################################################################

' each item will know it's type
' each item will have a name & index

pTaste As DWord
Weight As Double

' ---------------------------------------------------------------------
Function SetTaste(ByVal sTaste As String)
Me.pTaste = HEAP_ReAllocByStr(Me.pTaste, sTaste)
End Function

' ---------------------------------------------------------------------
Function Info()
' every extension of tFood MUST HAVE Info() or
' has to extend some extension of tFood that has Info()

PrintL Me.Type$(), Me.Name$, Me.Index In %brightYellow

' create layover of the real type at Me:
Local realMe Like Me.Type$() At VarPtr(Me)

' call Info() on the real type:
If realMe.Info() Then Nop

' use "If <...> Then Nop" to request a result even if none needed
' since it's dimensioned dynamic, using keyword "Like"

End Function
' ---------------------------------------------------------------------
Function Free() As DWord
' use a Free()-function on any data stored with tDatabase

' to free allocated resources that are noded to Me

PrintL Function_Name & ": " & Me.Name$, Me.Index In %brightYellow

' kill all information
Me.pType = 0
Me.pName = 0
Me.Index = 0

HEAP_Free(Me.pTaste)
Me.pTaste = 0
Me.Weight = 0

End Function

End Type

' #####################################################################
Type tFruit Extends tFood
' #####################################################################
Stones As Long
' ---------------------------------------------------------------------
Function Info()
PrintL " Taste " & HEAP_Get(Me.pTaste)
PrintL " Weight " & Me.Weight
PrintL " Stones " & Me.Stones
End Function
End Type

' #####################################################################
Type tMeat Extends tFood
' #####################################################################
Bones As Byte
' ---------------------------------------------------------------------
Function Info()
PrintL " Taste " & HEAP_Get(Me.pTaste)
PrintL " Weight " & Me.Weight
PrintL " Bones " & Me.Bones
End Function
End Type


' ---------------------------------------------------------------------

'[!] create Global Database:
Global Database As tDatabase


' ---------------------------------------------------------------------
Function TBMain()
' ---------------------------------------------------------------------
Local pAll() As DWord
Local i As Long

' .....................................................................
PrintL "adding some data to database: " In %brightYellow
PrintL

' dim meat as tMeat, named Porkchop at allocated memory
Local meat Like Database.Alloc("tMeat", "Porkchop") At Database.DataPtr
meat.Weight = 0.5
meat.SetTaste("yummy")
meat.Bones = 1

' allocate another tMeat, named Roulade
Database.Alloc("tMeat", "Roulade")
' place virtual meat upon last by Database used DataPtr
SetAt(meat, Database.DataPtr)
meat.Weight = 0.7
meat.SetTaste("sappy")

' dim fruit as tFruit, named Banana at allocated memory
Local fruit Like Database.Alloc("tFruit", "Banana") At Database.DataPtr
fruit.Weight = 0.2
fruit.setTaste("sweet")

' allocate another tFruit, named Apple
Database.Alloc("tFruit", "Apple")
SetAt(fruit, Database.DataPtr)
fruit.Weight = 0.3
fruit.SetTaste("bittersweet")
fruit.Stones = 14

' get a list of all data-ptrs:
Database.ListAll(pAll)

' prepare tFood -layover
Local item As tFood At 0

' let all items give information:

For i = 1 To CountOf(pAll)
SetAt( item, pAll(i) )
If item.Info() Then Nop
Next
PrintL
PrintL Repeat$(30, "-") & " key to continue" In %brightPurple
WaitKey
PrintL
' .....................................................................

PrintL "now free some data passing its name:"
PrintL

Database.Free("Roulade")
Database.Free("Banana")
PrintL

PrintL "now we have " & Str$(Database.ListAll(pAll)) & " items stored in database"


PrintL
PrintL Repeat$(30, "-") & " key to continue" In %brightPurple
WaitKey
PrintL
' .....................................................................

PrintL "adding 3 more items of food:" In %brightYellow

Database.Alloc("tMeat", "Liver")
SetAt(meat, Database.DataPtr)
meat.Weight = 1.5
meat.SetTaste("disgusting")

Database.Alloc("tFruit", "Peach")
SetAt(fruit, Database.DataPtr)
fruit.Weight = 0.35
fruit.SetTaste("very good")
fruit.Stones = 1

Database.Alloc("tFruit", "Apple")
SetAt(fruit, Database.DataPtr)
fruit.Weight = 0.4
fruit.SetTaste("sour")
fruit.Stones = 19

Database.ListAll(pAll)
PrintL "Now we have altogether:"

For i = 1 To CountOf(pAll)
SetAt( item, pAll(i) )
If item.Info() Then Nop
Next

PrintL
PrintL Repeat$(30, "-") & " key to continue" In %brightPurple
WaitKey
PrintL

' .....................................................................

Print "does Apple 2 exist? "
PrintL IIf$(Database.GetPtr("Apple", 2), "Yes", "No" ) In %brightYellow

Print "does Apple 3 exist? "
PrintL IIf$(Database.GetPtr("Apple", 3), "Yes", "No" ) In %brightYellow

Print "does a dataptr 123 exist in Database? "
PrintL IIf$(Database.IsPtr(123), "Yes", "No" ) In %brightYellow

Print "is current item valid for Database? "
PrintL IIf$(Database.IsPtr(GetAt(item)), "Yes", "No" ) In %brightYellow

Print "item is: " & Database.Name$(GetAt(item))
Print " " & Database.Index(GetAt(item))
PrintL " of type " & Database.TypeAt(GetAt(item))
PrintL

PrintL "porkchop is of type " & DataBase.Type$("porkchop")


PrintL
PrintL Repeat$(30, "-") & " key to continue" In %brightPurple
WaitKey
PrintL
' .....................................................................

If DataBase.ListName(pAll, "Apple") Then
PrintL "we have" & Str$(CountOf(pAll)) & " items named APPLE:"
PrintL

For i = 1 To CountOf(pAll)
SetAt( item, pAll(i) )
If item.Info() Then Nop
Next
EndIf

PrintL
PrintL Repeat$(30, "-") & " key to continue" In %brightPurple
WaitKey
' .....................................................................
PrintL

If DataBase.ListType(pAll, "tFruit") Then
PrintL "we have" & Str$(CountOf(pAll)) & " items of type tFruit:"
PrintL
For i = 1 To CountOf(pAll)
SetAt( item, pAll(i) )
If item.Info() Then Nop
Next
EndIf

PrintL
PrintL Repeat$(30, "-") & " key to continue" In %brightPurple
WaitKey
PrintL

' .....................................................................

PrintL "now free all data named Apple:" In %brightYellow
Database.Free("Apple")
PrintL
PrintL "then we have:"
If Database.ListAll(pAll) Then
For i = 1 To CountOf(pAll)
SetAt( item, pAll(i) )
If item.Info() Then Nop
Next
EndIf

PrintL
PrintL Repeat$(30, "-") & " key to continue" In %brightPurple
WaitKey
PrintL

' .....................................................................

PrintL "now free all passing a pointer" & $CRLF

For i = 1 To CountOf(pAll)
Database.FreeAt(pAll(i))
Next
PrintL
PrintL "we have " & Str$(Database.ListAll(pAll)) & " items stored in database"
PrintL
PrintL Repeat$(30, "-") & " key to end" In %brightPurple
WaitKey

End Function


Be assured- as soon as Hash-table has the ability to list all keys- i will come up with some better & faster methods to do the above :)

[ReneMiner]

It's just a raw sketch how we can use hash-tables to store similar objects of completely different types.

You could replace the udts tTest1 & tTest2 with

buttons, textboxes, treeviews etc. ("myButton" 1, "myButton" 2, "txtPassword" 1, "txtPassword" 2, ... )
or even with spaceships of klingons, borg, ferenghi, humans...

whatever different stuff you want to group that has something in common, a name (perhaps also an Index), same named methods that do something totally different depending on its type...

Not much to keep it understandeable.



' #Filename "test_Hashstuff.tBasic"
#MINVERSION 1.9.16.17

Uses "console"

' ----------------------------------------------------------------------
Function TBMain()
' ----------------------------------------------------------------------

Local myObjects As tHash
Local sKey, sKeys() As String
Local nKeys As Long


For nKeys = 1 To 3
sKey = myObjects.Make("tTest1", "someDoubles")
PrintL "Key " & nKeys & " is " & sKey In 14
PrintL " DataSize " & myObjects.DataSize(sKey)
PrintL " DataType " & myObjects.Type$(sKey)
PrintL " DataPtr " & myObjects.DataPtr
PrintL
Next

sKey = myObjects.Make("tTest2", "someLongs")
PrintL "Key 4 is " & sKey In 14
PrintL " DataSize " & myObjects.DataSize(sKey)
PrintL " DataType " & myObjects.Type$("SomeL") ' will this work?
PrintL " DataPtr " & myObjects.DataPtr
PrintL

PrintL $CRLF & Repeat$(30, "-") & " key to continue" In 28
WaitKey
PrintL

Print "Keys that start with "
PrintL "someDoubles" In 12

nKeys = myObjects.listOf("SomeDoubles", sKeys)
While nKeys
' ( just go backward here to avoid more variables )
PrintL sKeys(nKeys)
nKeys -= 1
Wend

PrintL $CRLF & Repeat$(30, "-") & " key to end" In 28
WaitKey

End Function

' this be 2 totally different udts that we store to a hash-table:

' #######################################################################
Type tTest1
' #######################################################################
d1 As Double
d2 As Double
d3 As Double
' .......................................................................
End Type
' .......................................................................

' #######################################################################
Type tTest2
' #######################################################################
l1 As Long
l2 As Long
' .......................................................................
End Type
' .......................................................................



' this the hash-table that allows to name and index data of different type
' it also "knows" the size & type of stored data
' #######################################################################
Type tHash
' #######################################################################
Private
pHash As DWord

Public
DataPtr As DWord ' holds the last affected ptr
DataType As String ' holds last keys type

' ----------------------------------------------------------------------
Function _Create(Optional ByVal capacity As Long = 200)
' ----------------------------------------------------------------------

' setup some space:
If Me.pHash = 0 Then
capacity = MinMax(capacity, 50, &H3FFFFFFF)
Me.pHash = Hash_New(capacity)

EndIf


End Function

' ----------------------------------------------------------------------
Function Make(ByVal sType As String, _
ByVal sName As String, _
Optional ByVal Index As Long = 1 _
) As String
' ----------------------------------------------------------------------
' create space for a variable of sType with the passed name and index

Static pAllTypes As DWord

If Not Hash_Validate(Me.pHash) Then Return ""

Local i As Long
Local pType As DWord
Local sKey As String = sName & Hex$(Index, 8)

Local data Like sType At 0



While Hash_Exists(Me.pHash, sKey)
' make sure the key is unique:
Index += 1
sKey = sName & Hex$(Index, 8)
Wend

If Hash_Count(Me.pHash) + 2 >= Hash_CapGet(Me.pHash) Then
' if we exceed the capacity simply double it:
Hash_CapSet(Me.pHash, Hash_CapGet(Me.pHash) * 2)

EndIf


sType = Ucase$(sType) ' from here all type-names work in UCASE

If HEAP_Size(pAllTypes) Then ' are there any pointers already?
' place virtual Dword-array upon the pointer-list:
Local vPtr(HEAP_Size(pAllTypes)/4) As DWord At pAllTypes
' and scan if any of the list points the requested type-name
i = Array Scan vPtr Ptr, = sType
EndIf

If i Then
pType = vPtr(i)
Else
' create a new Heap that stores the type:
HEAP_Set pType, sType
' append the new pointer to the list
HEAP_Set( pAllTypes, HEAP_Get(pAllTypes) & MKDWD$(pType) )
EndIf

' create a slot for the data and poke its type in front
Hash_Set(Me.pHash, sKey, MKDWD$(pType) & Repeat$(SizeOf(data), MKBYT$(0)))

' set dataPtr to hold position where the data starts:
Me.DataPtr = Hash_GetPtr(Me.pHash, sKey) + 4

' datatype be current type of data
Me.DataType = sType


' return the key for the data:
Function = sKey

End Function

' ----------------------------------------------------------------------
Function Type$(ByVal sKey As String) As String
' ----------------------------------------------------------------------
' find out the type of data which we have a key for:

If Hash_Exists(Me.pHash, sKey) Then
Me.DataPtr = Hash_GetPtr(Me.pHash, sKey) + 4
Me.DataType = HEAP_Get(Peek(DWord, Hash_GetPtr(Me.pHash, sKey)))
Else
' if the key does not exist we check for any
' key that starts with the passed sKey:
Local sList() As String
If Me.ListOf(sKey, sList) > 0 Then
Me.DataPtr = Hash_GetPtr(Me.pHash, sList(1)) + 4
Me.DataType = HEAP_Get(Peek(DWord, Hash_GetPtr(Me.pHash, sList(1))))
Else
Me.DataPtr = 0
Me.Dataype = "Variant"
EndIf
EndIf

Function = Me.DataType


End Function

' ----------------------------------------------------------------------
Function DataSize(ByVal sKey As String) As Long
' ----------------------------------------------------------------------

Local data Like Me.Type$(sKey) At 0
Function = SizeOf(data)

End Function

' ----------------------------------------------------------------------
Function ListOf(ByVal sKeypart As String, _
ByRef sFound() As String _
) As Long
' ----------------------------------------------------------------------
' get a list of all keys that start with sKeypart
' into byref passed sFound()
' returns count of matches

Local sKeys, sList() As String
Local nKeys As Long

sKeys = Hash_GetKeys(Me.pHash, $CRLF)
nKeys = Parse sKeys, sList, $CRLF
Function = Array Extract sList, Collate Ucase, StartsWith sKeypart InTo sFound

End Function


' .......................................................................
End Type
' .......................................................................

Global myHash As tHash(500)


To use data contained in a "hash-slot" for the layover-stuff its necessary to dimension tHash global as shown at the end of the script.

Then you can think of


' create key for a requested object as:
Local Index As Long = 123
Local sKey As String = "Klingon" & Hex$(Index, 8)

' layover to object-data
Local Ship1 Like myHash.Type$(sKey) At myHash.DataPtr


Index = Ship1.GetClosestShipIndex("Human")
' build the needed key:
sKey = "Human" & Hex$(Index, 8)

Local Ship2 Like myHash.Type$(sKey) At myHash.DataPtr
' humans may have different brands of ships...

If Ship1.GunsLoaded Then
Ship1.SetTarget( Ship2.Position )
Ship1.Fire
Ship2.Shields -=Ship1.Firepower
If Ship2.Shields <= 0 Then
Ship2.Explode
'...

[ReneMiner]

' #Filename "test_HashFunctions2.tBasic"
#MINVERSION 1.9.16.17

Uses "console"
' every bucket in the database can hold
' - any type of variable - except strings
' - a list (dynamic Array) of fixed size variables or just single elements

' very simple: in front of data is a Dword
' similar to BString/ dynamic string "StrPtrLen(StrPtr( ))"
' but this Dword is a pointer to some Heap-Memory where
' the type-name can be read out using Heap_Get()

' ----------------------------------------------------------------------
Function TBMain()
' ----------------------------------------------------------------------
' create a database:
Local db As tDatabase

' little helpers:
Local i As Long
Local sKeys() As String

' this makes an array of 3 doubles, named "myDoubleArray", 1:
db.Store "Double", "myDoubleArray", 1, MKD$(1.1, 2.2, 3.3)


' some information about current data:
PrintL db.DataKey In 15
PrintL " Type " & db.DataType
PrintL " CountOf " & db.DataCountOf
PrintL " SizeOf " & db.DataSizeOf
PrintL " Len " & db.DataLen

' place a virtual layover onto the data:
Local data1(db.DataCountOf) Like db.DataType At db.DataPtr

PrintL
' now show data itself:
For i = 1 To db.DataCountOf
PrintL i, data1(i)
Next
PrintL

PrintL $CRLF & Repeat$(30, "-") & " key to continue" In 28
WaitKey
PrintL

Print "now create an array of type "
' this makes space for a list of longs - or at least 1 long:
PrintL db.Store("Long", "myLongList") In 15
Print "it's key is "
PrintL db.DataKey In 15
PrintL

PrintL "setting data: 5, 4, 3, 2, 1"
db.DataSet(MKL$(5, 4, 3, 2, 1))
PrintL
PrintL "just for fun append some more data: 0, -1, -2"
db.DataSet db.DataGet & MKL$(0, -1, -2)
PrintL

Print "now create an array of type "
' this makes another array of 4 doubles, named "myDoubleArray", 255
PrintL db.Store("Double", "myDoubleArray", 255, 4) In 15

' place the layover onto the data-space:
ReDim data1(db.DataCountOf) At db.DataPtr
PrintL "fill via layover with"
For i = 1 To db.DataCountOf
data1(i) = 1.23 * i
PrintL i, data1(i)
Next
PrintL $CRLF & Repeat$(30, "-") & " key to continue" In 28
WaitKey
PrintL

PrintL "access something that is stored as " & $DQ & "myLong" & $DQ
db.Access("myLong")

PrintL db.DataKey In 15
PrintL " Type " & db.DataType
PrintL " CountOf " & db.DataCountOf
PrintL " SizeOf " & db.DataSizeOf
PrintL " Len " & db.DataLen

Local data2(db.DataCountOf) Like db.DataType At db.DataPtr

For i = 1 To db.DataCountOf
PrintL i, data2(i)
Next

PrintL $CRLF & Repeat$(30, "-") & " key to continue" In 28
WaitKey
PrintL
PrintL "access something that is stored as " & $DQ & "myDoubleArray" & $DQ & ", 255"
db.access("myDoubleArray", 255)
PrintL db.DataKey In 15
PrintL " Type " & db.DataType
PrintL " CountOf " & db.DataCountOf
PrintL " SizeOf " & db.DataSizeOf
PrintL " Len " & db.DataLen
Local data3(db.DataCountOf) Like db.DataType At db.DataPtr

For i = 1 To db.DataCountOf
PrintL i, data3(i)
Next

PrintL $CRLF & Repeat$(30, "-") & " key to continue" In 28
WaitKey
PrintL
PrintL "list all keys that start with " & $DQ & "my" & $DQ
i = db.ListOf "my", sKeys
While i
PrintL sKeys(i)
i -= 1
Wend
PrintL


PrintL "now free all data that is named as " & $DQ & "myDouble" & $DQ
db.DataFree("myDouble")
PrintL "and list all keys that start with " & $DQ & "my" & $DQ & " again"

i = db.ListOf "my", sKeys
While i
PrintL sKeys(i)
i -= 1
Wend
PrintL



PrintL $CRLF & Repeat$(30, "-") & " key to end" In 28
WaitKey

End Function

'---------------------------------------------------------------------------------
Function Type_Enumerate(ByVal sType As String, _
Optional ByVal TestExist As Boolean _
) As DWord
'---------------------------------------------------------------------------------
' to create a global uniform Type-name-enumeration
' every type gets stored only once
' the "enumerated" number can be used to compare types.

' every "enumerated" number is unique since it's a memory-pointer
' which is valid until the script ends

' all type-names get stored in UCase and can be read out at this
' pointer using Heap_Get()

Static hAllTypes As DWord
' this points a heap with a list of pointers to all enumerated type-names

Local Index As Long ' will hold the index of requested pointer


If Not Type_Exists(sType) Then
MsgBox 0, "invalid type-name passed: " & $DQ & sType & $DQ, _
%MB_OK Or %MB_ICONERROR, "Type_Enumerate: Error"
Stop
EndIf

sType = Ucase$(sType) ' from here all type-names work in UCASE

If HEAP_Size(hAllTypes) Then ' are there any pointers already?
' place virtual Dword-array upon the pointer-list:
Local vPtr(HEAP_Size(hAllTypes)/4) As DWord At hAllTypes

' and scan if any of the list points the requested type-name
Index = Array Scan vPtr Ptr, = sType

If Index Then
Return vPtr(Index)
EndIf

EndIf

' does not exist yet:
If TestExist Then Return 0

' store sType and append its Pointer to function-static hAllTypes
HEAP_Set(hAllTypes, HEAP_Get(hAllTypes) & MKDWD$(HEAP_AllocByStr(sType)) )

' return last appended pointer
Function = Peek(DWord, HEAP_End(hAllTypes) - 3 )

' use Heap_Get() on the result to read type-name

End Function

' #######################################################################
Type tDatabase
' #######################################################################
Private
pHash As DWord

Public
' these hold values of the last accessed bucket:
DataKey As String
DataPtr As DWord
DataType As String
DataCountOf As Long
DataSizeOf As Long
DataLen As Long

' ----------------------------------------------------------------------
Function _Create(Optional ByVal capacity As Long = 384)
' ----------------------------------------------------------------------
' create some space:

If Me.pHash = 0 Then
capacity = MinMax(capacity, 50, &H3FFFFFFF)
Me.pHash = Hash_New(capacity)
EndIf


End Function

' ----------------------------------------------------------------------
Function Store( ByVal sType As String, _
ByVal sName As String, _
Optional ByVal Index As Long, _
ByVal sData As String _
) As String
' ----------------------------------------------------------------------
' creates a new entry to the database

' make sure this tDatabase is valid:
If Not Hash_Validate(Me.pHash) Then
MsgBox 0, "pointer of hash-table invalid:" & Str$(Me.pHash), _
%MB_OK Or %MB_ICONERROR, "tDatabase.Store: Error"
Stop
EndIf

' if we exceed the capacity enlarge the database:
If Hash_Count(Me.pHash) + 3 >= Hash_CapGet(Me.pHash) Then
Hash_CapSet(Me.pHash, Hash_CapGet(Me.pHash) * 1.5)
EndIf

' store type & get a pointer where to read it:
Local pType As DWord = Type_Enumerate(sType)
Me.DataType = sType

' create key from name & Index:
Me.DataKey = sName & Hex$(Index, 8)

' make sure the key is unique:
While Hash_Exists(Me.pHash, Me.DataKey)
Index += 1
Me.DataKey = sName & Hex$(Index, 8)
Wend

Local data Like sType At 0
Me.DataSizeOf = SizeOf(data)

If StrPtrLen(StrPtr(sData)) = 0 Then
' if no data passed create 1 element filled with 0
sData = Repeat$(Me.DataSizeOf, MKBYT$(0))
Me.DataCountOf = 1
Else
If All( StrPtrLen(StrPtr(sData)) < SizeOf(data), _
Val(sData) > 0 _
) Then
Me.DataCountOf = Val(sData)
sData = Repeat$(Me.DataSizeOf * Me.DataCountOf, MKBYT$(0))
Else
Me.DataCountOf = StrPtrLen(StrPtr(sData))/Me.DataSizeOf
EndIf
EndIf

Me.DataLen = StrPtrLen(StrPtr(sData))
' store type & data:
Hash_Set(Me.pHash, Me.DataKey, MKDWD$(pType) & sData)

' get the pointer where data starts:
Me.DataPtr = Hash_GetPtr(Me.pHash, Me.DataKey) + 4


Function = Me.DataType
End Function

' ----------------------------------------------------------------------
Function Access(ByVal sKey As String, _
Optional ByVal Index As Long _
) As String
' ----------------------------------------------------------------------
' this will fill udt-elements of the database
' if no index passed it will use any bucket thats
' key starts with sKey

' make sure this tDatabase is valid:
If Not Hash_Validate(Me.pHash) Then
MsgBox 0, "pointer of hash-table invalid:" & Str$(Me.pHash), _
%MB_OK Or %MB_ICONERROR, "tDatabase.Access: Error"
Stop
EndIf

If Function_CParams = 2 Then
sKey = sKey & Hex$(Index, 8)
EndIf

If Not Hash_Exists(Me.pHash, sKey) Then
' if the key does not exist then check for any
' key that starts with the passed sKey:
Local sList() As String
If Me.ListOf(sKey, sList) > 0 Then
sKey = sList(1)
Else
MsgBox 0, "invalid key " & $DQ & sKey & $DQ & " passed", _
%MB_OK Or %MB_ICONERROR, "tDatabase.Access: Error"
Stop
EndIf
EndIf

Local sData As String = Hash_Get(Me.pHash, sKey)
sData = Memory_Get(StrPtr(sData) + 4, StrPtrLen(StrPtr(sData)) - 4)

Me.DataKey = sKey
Me.DataPtr = Hash_GetPtr(Me.pHash, sKey) + 4
Me.DataType = HEAP_Get(Peek(DWord, Me.DataPtr - 4))

Local data Like Me.DataType At Me.DataPtr
Me.DataSizeOf = SizeOf(data)
Me.DataLen = StrPtrLen(StrPtr(sData))
Me.DataCountOf = Me.DataLen / Me.DataSizeOf

Function = sData


End Function

' ----------------------------------------------------------------------
Function ListOf(ByVal sKeypart As String, _
ByRef sFound() As String _
) As Long
' ----------------------------------------------------------------------
' get a list of all keys that start with sKeypart
' into byref passed sFound()
' returns count of matches

Local sKeys, sList() As String
Local nKeys As Long

sKeys = Hash_GetKeys(Me.pHash, $CRLF)
nKeys = Parse sKeys, sList, $CRLF
Function = Array Extract sList, Collate Ucase, StartsWith sKeypart InTo sFound

End Function

' ----------------------------------------------------------------------
Function DataSet( ByVal sData As String ) As DWord
' ----------------------------------------------------------------------
' this will set new data to last accessed bucket
' returns pointer where data was stored

If Not Hash_Exists(Me.pHash, Me.DataKey) Then Return 0

Local pType As DWord = Peek(DWord, Me.DataPtr - 4)
If StrPtrLen(StrPtr(sData)) < Me.DataSizeOf Then
sData = Repeat$(Me.DataSizeOf, MKBYT$(0))
EndIf
Me.DataLen = StrPtrLen(StrPtr(sData))
Me.DataCountOf = Me.DataLen / Me.DataSizeOf

Hash_Set(Me.pHash, Me.DataKey, MKDWD$(pType) & sData)
Me.DataPtr = Hash_GetPtr(Me.pHash, Me.DataKey) + 4

Function = Me.DataPtr

End Function

' ----------------------------------------------------------------------
Function DataGet() As String
' ----------------------------------------------------------------------
' this will get data of last accessed bucket

If Not Hash_Exists(Me.pHash, Me.DataKey) Then Return ""
Function = Memory_Get(Me.DataPtr, Me.DataLen)

End Function

' ----------------------------------------------------------------------
Function DataFree(Optional ByVal sKey As String, _
ByVal Index As Long )
' ----------------------------------------------------------------------
' this will free data
Local sList() As String
Local lCount As Long

If Function_CParams = 0 Then
ReDim sList(1)
sList(1) = Me.DataKey
lCount = 1
ElseIf Function_CParams = 2 Then
ReDim sList(1)
sList(1) = sKey & Hex$(Index, 8)
lCount = 1
Else
lCount = Me.ListOf(sKey, sList)
EndIf

While lCount
If Hash_Exists(Me.pHash, sList(lCount)) Then
Hash_Del(Me.pHash, sList(lCount))
lCount -= 1
EndIf
Wend

Me.DataKey = ""
Me.DataPtr = 0
Me.DataType = ""
Me.DataCountOf = 1
Me.DataSizeOf = 0
Me.DataLen = 0

End Function

' .......................................................................
End Type
' .......................................................................