In the SDK of PureBasic there is the example for the Object Management Ticket.
Here as an example as DataSet, also for the use with threads.
Code: Select all
;-TOP by mk-soft, v1.01, 27.07.2024
CompilerIf Not #PB_Compiler_Thread
CompilerError "Use Compiler Option ThreadSafe!"
CompilerEndIf
DeclareModule pbObjectCommon
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Import ""
PB_Object_GetOrAllocateID(*Objects, ID)
PB_Object_GetObject(*Objects, DynamicOrArrayID)
PB_Object_IsObject(*Objects, DynamicOrArrayID)
PB_Object_IsHandle(*Objects, *NativeHandle)
PB_Object_EnumerateAll(*Objects, *ObjectEnumerateAllCallback, *pData)
PB_Object_EnumerateStart(*Objects)
PB_Object_EnumerateStartRecursive(*Objects)
PB_Object_EnumerateNext(*Objects, *ID)
PB_Object_EnumerateNextRecursive(*Objects, *ID)
PB_Object_EnumerateAbort(*Objects)
PB_Object_FreeID(*Objects, DynamicOrArrayID)
PB_Object_CleanAll(*Objects)
PB_Object_Init(StructureSize, IncrementStep, *ObjectFreeFunction)
PB_Object_Count(*Objects)
EndImport
CompilerElse
ImportC ""
PB_Object_GetOrAllocateID(*Objects, ID)
PB_Object_GetObject(*Objects, DynamicOrArrayID)
PB_Object_IsObject(*Objects, DynamicOrArrayID)
PB_Object_IsHandle(*Objects, *NativeHandle)
PB_Object_EnumerateAll(*Objects, *ObjectEnumerateAllCallback, *pData)
PB_Object_EnumerateStart(*Objects)
PB_Object_EnumerateStartRecursive(*Objects)
PB_Object_EnumerateNext(*Objects, *ID)
PB_Object_EnumerateNextRecursive(*Objects, *ID)
PB_Object_EnumerateAbort(*Objects)
PB_Object_FreeID(*Objects, DynamicOrArrayID)
PB_Object_CleanAll(*Objects)
PB_Object_Init(StructureSize, IncrementStep, *ObjectFreeFunction)
PB_Object_Count(*Objects)
EndImport
CompilerEndIf
EndDeclareModule
Module pbObjectCommon
;
EndModule
; ********
DeclareModule DataSet
Declare NewDataSet(ID, Value = 0, Text.s = "")
Declare FreeDataSet(ID)
Declare IsDataSet(ID)
Declare GetDataSetValue(ID)
Declare.s GetDataSetText(ID)
Declare SetDataSetValue(ID, Value)
Declare AddDataSetValue(ID, Value)
Declare SetDataSetText(ID, Text.s)
EndDeclareModule
Module DataSet
EnableExplicit
UseModule pbObjectCommon
Structure udtDataSet
; Object Header
RESERVED_OR_OS_HANDLE.i
; Object Data
Mutex.i
iValue.i
sText.s
EndStructure
Global *ObjectDataSet
; ----
Procedure FreeDataSet(ID)
Protected *Object.udtDataSet
*Object = PB_Object_IsObject(*ObjectDataSet, ID)
If *Object
FreeMutex(*Object\Mutex)
ClearStructure(*Object, udtDataSet)
PB_Object_FreeID(*ObjectDataSet, ID)
EndIf
EndProcedure
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure ObjectFreeFunctionCB(ID)
FreeDataSet(ID)
EndProcedure
CompilerElse
ProcedureC ObjectFreeFunctionCB(ID)
FreeDataSet(ID)
EndProcedure
CompilerEndIf
; ----
Procedure InitObject()
*ObjectDataSet = PB_Object_Init(SizeOf(udtDataSet), 16, @ObjectFreeFunctionCB())
EndProcedure : InitObject()
; ----
Procedure NewDataSet(ID, Value = 0, Text.s = "")
Protected *object.udtDataSet
CompilerIf #PB_Compiler_Debugger
If id >= 0 And id > 10000
Debug "Warning NewDataSet over 10000 Array Elements!"
EndIf
CompilerEndIf
*object = PB_Object_GetOrAllocateID(*ObjectDataSet, ID)
If *object
InitializeStructure(*object, udtDataSet)
*object\RESERVED_OR_OS_HANDLE = #True ; Must be set
*object\Mutex = CreateMutex()
*object\iValue = Value
*object\sText = Text
EndIf
ProcedureReturn *object
EndProcedure
; ----
Procedure IsDataSet(ID)
Protected r1, *object.udtDataSet
*object = PB_Object_IsObject(*ObjectDataSet, ID)
ProcedureReturn *object
EndProcedure
; ----
Procedure GetDataSetValue(ID)
Protected r1, *object.udtDataSet
*object = PB_Object_IsObject(*ObjectDataSet, ID)
If *object
LockMutex(*object\Mutex)
r1 = *object\iValue
UnlockMutex(*object\Mutex)
EndIf
ProcedureReturn r1
EndProcedure
; ----
Procedure.s GetDataSetText(ID)
Protected r1.s, *object.udtDataSet
*object = PB_Object_IsObject(*ObjectDataSet, ID)
If *object
LockMutex(*object\Mutex)
r1 = *object\sText
UnlockMutex(*object\Mutex)
EndIf
ProcedureReturn r1
EndProcedure
; ----
Procedure SetDataSetValue(ID, Value)
Protected *object.udtDataSet
*object = PB_Object_IsObject(*ObjectDataSet, ID)
If *object
LockMutex(*object\Mutex)
*object\iValue = Value
UnlockMutex(*object\Mutex)
EndIf
EndProcedure
; ----
Procedure AddDataSetValue(ID, Value)
Protected *object.udtDataSet
*object = PB_Object_IsObject(*ObjectDataSet, ID)
If *object
LockMutex(*object\Mutex)
*object\iValue + Value
UnlockMutex(*object\Mutex)
EndIf
EndProcedure
; ----
Procedure SetDataSetText(ID, Text.s)
Protected *object.udtDataSet
*object = PB_Object_IsObject(*ObjectDataSet, ID)
If *object
LockMutex(*object\Mutex)
*object\sText = Text
UnlockMutex(*object\Mutex)
EndIf
EndProcedure
EndModule
; ********
CompilerIf #PB_Compiler_IsMainFile
;-Test
UseModule DataSet
Debug "Create Numbered DataSet"
NewDataSet(0, 1, "Number 1")
NewDataSet(1, 2, "Number 2")
Debug GetDataSetValue(0)
Debug GetDataSetText(0)
Debug GetDataSetValue(1)
Debug GetDataSetText(1)
Debug "Overwrite DataSet"
NewDataSet(0, 10, "Number 10")
Debug GetDataSetValue(0)
Debug GetDataSetText(0)
Debug "Change DataSet"
SetDataSetValue(0, 1000)
SetDataSetText(0, "Number 1000")
Debug GetDataSetValue(0)
Debug GetDataSetText(0)
Debug "Create Any DataSet"
id = NewDataSet(#PB_Any, 100, "Hello world!")
Debug GetDataSetValue(id)
Debug GetDataSetText(id)
Debug "FreeDataSet"
FreeDataSet(0)
Debug IsDataSet(0)
FreeDataSet(1)
Debug IsDataSet(1)
FreeDataSet(id)
Debug IsDataSet(id)
Debug "Threads - Wait 25s"
Procedure thWorkAdd(ID)
Protected c
Debug "Add start ID " +id
Delay(100)
For c = 1 To 1000
AddDataSetValue(id, 1)
Delay(20)
Next
Debug "Add Done ID " +id
EndProcedure
Procedure thWorkSub(ID)
Protected c
Debug "Sub Start ID " +id
Delay(100)
For c = 1 To 1000
AddDataSetValue(id, -1)
Delay(10)
Next
Debug "Sub Done ID " +id
EndProcedure
NewDataSet(0, 100)
NewDataSet(1, 200)
NewDataSet(2, 300)
id = NewDataSet(#PB_Any, 400)
CreateThread(@thWorkAdd(), 0)
CreateThread(@thWorkAdd(), 1)
CreateThread(@thWorkAdd(), 2)
CreateThread(@thWorkAdd(), id)
CreateThread(@thWorkSub(), 0)
CreateThread(@thWorkSub(), 1)
CreateThread(@thWorkSub(), 2)
CreateThread(@thWorkSub(), id)
Delay(25000)
Debug "Result"
Debug GetDataSetValue(0)
Debug GetDataSetValue(1)
Debug GetDataSetValue(2)
Debug GetDataSetValue(id)
CompilerEndIf
