fb:porticula NoPaste
linkedlist.bi
Uploader: | ThePuppetMaster |
Datum/Zeit: | 22.04.2009 09:53:42 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Linked List, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'###################################################################################################################################
'# LL_INT_LinkedList Version: 2.00.0 - 30.03.2009
'###################################################################################################################################
'# Autor: /_\ DeltaLab's Germany - Experimental Computing
'# Writer: Martin Wiemann - Admin@MLN.ath.cx - IRC://MLN.ath.cx/#mln
'# Idea: 20:50:53 - 30.03.2009
'###################################################################################################################################
'# This sourcecode is open source! Full or parts of this source CAN copy. Do what u want!
'###################################################################################################################################
'###################################################################################################################################
Enum LL_StoreFormat
LL_SF_Unknown = 0
LL_SF_LL = 1
LL_SF_XML = 2
End Enum
Enum LL_DataType
LL_DT_Unknown = 0
LL_DT_LL = 1
LL_DT_String = 2
LL_DT_UInteger = 3
LL_DT_Integer = 4
LL_DT_AnyPtr = 5
End Enum
Type LL_INT_LinkedList
V_Next as LL_INT_LinkedList Ptr
V_Prev as LL_INT_LinkedList Ptr
V_Root as LL_INT_LinkedList Ptr
V_Parent as LL_INT_LinkedList Ptr
V_ChildF as LL_INT_LinkedList Ptr
V_ChildL as LL_INT_LinkedList Ptr
V_DataType as LL_DataType
V_Data as String
V_DataX as UInteger
End Type
#IFDEF LL_DEF_ThreadSafe
'###################################################################################################################################
Dim Shared LL_INT_Mutex as Any Ptr
'-----------------------------------------------------------------------------------------------------------------------------------
Sub LL_INT_Construct() Constructor
LL_INT_Mutex = MutexCreate()
End Sub
'-----------------------------------------------------------------------------------------------------------------------------------
Sub LL_INT_Destruct() Constructor
MutexDestroy(LL_INT_Mutex)
LL_INT_Mutex = 0
End Sub
#ENDIF
'###################################################################################################################################
Public Function LL_DatatypeName(V_Datatype as LL_DataType) as String
Select Case V_Datatype
Case LL_DT_Unknown: Return "[Unknown]"
Case LL_DT_LL: Return "LinkedList"
Case LL_DT_String: Return "String"
Case LL_DT_UInteger: Return "UInteger"
Case LL_DT_Integer: Return "Integer"
Case LL_DT_AnyPtr: Return "Any Ptr"
Case Else: Return "[Unknown Datatype]"
End Select
End Function
'###################################################################################################################################
Private Function LL_INT_Item_Add(ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr, V_Parent as LL_INT_LinkedList Ptr, V_Root as LL_INT_LinkedList Ptr, V_Index as UInteger = 0) as LL_INT_LinkedList Ptr
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = RV_LF
Dim NPtr as LL_INT_LinkedList Ptr
If V_Index > 0 Then
Do Until TPtr = 0
C += 1
If C = V_Index Then Exit Do
TPtr = TPtr->V_Next
Loop
If TPtr <> 0 Then
NPtr = CAllocate(SizeOf(LL_INT_LinkedList))
NPtr->V_Next = TPtr
NPtr->V_Prev = TPtr->V_Prev
TPtr->V_Prev = NPtr
If TPtr->V_Prev <> 0 Then TPtr->V_Prev->V_Next = NPtr
Return NPtr
End If
End If
If NPtr = 0 Then
If RV_LL <> 0 Then
RV_LL->V_Next = CAllocate(SizeOf(LL_INT_LinkedList))
RV_LL->V_Next->V_Prev = RV_LL
RV_LL = RV_LL->V_Next
Else
RV_LL = CAllocate(SizeOf(LL_INT_LinkedList))
RV_LF = RV_LL
End If
NPtr = RV_LL
End If
With *NPtr
.V_Parent = V_Parent
.V_Root = V_Root
End With
Return NPtr
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LL_INT_Item_Get(V_LF as LL_INT_LinkedList Ptr, V_Index as UInteger) as LL_INT_LinkedList Ptr
If V_LF = 0 Then Return 0
If V_Index = 0 Then Return 0
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = V_LF
Do Until TPtr = 0
C += 1
If C = V_Index Then Exit Do
TPtr = TPtr->V_Next
Loop
Return TPtr
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LL_INT_Item_Del(ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr, V_Index as UInteger)
Dim TPtr as LL_INT_LinkedList Ptr = LL_INT_Item_Get(RV_LF, V_Index)
If TPtr = 0 Then Exit Sub
With *TPtr
If .V_Next <> 0 Then .V_Next->V_Prev = .V_Prev
If .V_Prev <> 0 Then .V_Prev->V_Next = .V_Next
If RV_LF = TPtr Then RV_LF = TPtr->V_Next
If RV_LL = TPtr Then RV_LL = TPtr->V_Prev
End With
If TPtr->V_DataType = LL_DT_AnyPtr Then
If Cast(Any Ptr, TPtr->V_DataX) <> 0 Then DeAllocate(Cast(Any Ptr, TPtr->V_DataX))
End If
DeAllocate(TPtr)
End Sub
'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LL_INT_Item_Clear(ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr)
Do Until RV_LF = 0
RV_LL = RV_LF->V_Next
LL_INT_Item_Clear(RV_LF->V_ChildF, RV_LF->V_ChildL)
If RV_LF->V_DataType = LL_DT_AnyPtr Then
If Cast(Any Ptr, RV_LF->V_DataX) <> 0 Then DeAllocate(Cast(Any Ptr, RV_LF->V_DataX))
End If
DeAllocate(RV_LF)
RV_LF = RV_LL
Loop
End Sub
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LL_INT_Item_Count(V_LF as LL_INT_LinkedList Ptr) as UInteger
If V_LF = 0 Then Return 0
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = V_LF
Do Until TPtr = 0
C += 1
TPtr = TPtr->V_Next
Loop
Return C
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LL_INT_Item_GetIndex(V_LF as LL_INT_LinkedList Ptr, V_LC as LL_INT_LinkedList Ptr) as UInteger
If V_LF = 0 Then Return 0
If V_LC = 0 Then Return 0
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = V_LF
Do Until TPtr = 0
C += 1
If TPtr = V_LC Then Return C
TPtr = TPtr->V_Next
Loop
Return 0
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LL_INT_Item_TreePut(V_FNID as Integer, V_Format as LL_StoreFormat, V_WithSubTree as Byte, V_LF as LL_INT_LinkedList Ptr, V_DeepStep as UInteger = 1)
If V_LF = 0 Then Exit Sub
Dim TPtr as LL_INT_LinkedList Ptr = V_LF
Dim T as String
Dim L as UInteger
Dim L2 as UInteger
Dim CSL as UInteger
Select Case V_Format
Case LL_SF_LL
Do Until TPtr = 0
With *TPtr
Print #V_FNID, Chr(.V_DataType and 255); Chr((.V_DataType shr 8) and 255); Chr((.V_DataType shr 16) and 255); Chr((.V_DataType shr 24) and 255);
Select Case .V_DataType
Case LL_DT_LL
LL_INT_Item_TreePut(V_FNID, V_Format, 1, Cast(LL_INT_LinkedList Ptr, .V_DataX))
Case LL_DT_String
L2 = Len(.V_Data)
Print #V_FNID, Chr(L2 and 255); Chr((L2 shr 8) and 255); Chr((L2 shr 16) and 255); Chr((L2 shr 24) and 255);
Print #V_FNID, .V_Data;
Case LL_DT_UInteger, LL_DT_Integer
Print #V_FNID, Chr(.V_DataX and 255); Chr((.V_DataX shr 8) and 255); Chr((.V_DataX shr 16) and 255); Chr((.V_DataX shr 24) and 255);
End Select
If V_WithSubTree = 1 Then
If .V_ChildF <> 0 Then
Print #V_FNID, Chr(255, 255, 255, 255);
LL_INT_Item_TreePut(V_FNID, V_Format, V_WithSubTree, .V_ChildF)
End If
End If
End With
TPtr = TPtr->V_Next
Loop
Print #V_FNID, Chr(0, 0, 0, 0);
Case LL_SF_XML
Do Until TPtr = 0
With *TPtr
Print #V_FNID, Space(V_DeepStep); "<ITEM>"
Print #V_FNID, Space(V_DeepStep);" <TYPE>";
Select Case .V_DataType
Case LL_DT_LL: Print #V_FNID, "LL";
Case LL_DT_String: Print #V_FNID, "String";
Case LL_DT_UInteger: Print #V_FNID, "UInteger";
Case LL_DT_Integer: Print #V_FNID, "Integer";
Case LL_DT_AnyPtr: Print #V_FNID, "AnyPtr";
End Select
Print #V_FNID, "</TYPE>"
Print #V_FNID, Space(V_DeepStep);" <DATA>";
Select Case .V_DataType
Case LL_DT_LL: LL_INT_Item_TreePut(V_FNID, V_Format, 1, Cast(LL_INT_LinkedList Ptr, .V_DataX), V_DeepStep + 1)
Case LL_DT_String: Print #V_FNID, .V_Data;
Case LL_DT_UInteger: Print #V_FNID, Str(Cast(UInteger, .V_DataX));
Case LL_DT_Integer: Print #V_FNID, Str(Cast(Integer, .V_DataX));
Case LL_DT_AnyPtr
End Select
Print #V_FNID, "</DATA>"
If V_WithSubTree = 1 Then If .V_ChildF <> 0 Then LL_INT_Item_TreePut(V_FNID, V_Format, V_WithSubTree, .V_ChildF, V_DeepStep + 1)
Print #V_FNID, Space(V_DeepStep);"</ITEM>"
End With
TPtr = TPtr->V_Next
Loop
End Select
End Sub
'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LL_INT_Item_XMLDataParse(V_FNID as Integer, ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr, V_Parent as LL_INT_LinkedList Ptr, V_Root as LL_INT_LinkedList Ptr, V_DataMax as UInteger, ByRef V_DataPos as UInteger = 1, ByRef V_Data as String = "")
End Sub
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LL_INT_Item_LLDataParse(V_FNID as Integer, ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr, V_Parent as LL_INT_LinkedList Ptr, V_Root as LL_INT_LinkedList Ptr, V_DataMax as UInteger, ByRef V_DataPos as UInteger = 1, ByRef V_Data as String = "") as Integer
Dim T as String = Space(6000)
Dim XType as UInteger
Dim L2 as UInteger
Dim XRV as Integer
Dim XTV as UInteger = Cast(UInteger, -1)
Do
If Len(V_Data) < 4 Then
If V_DataPos >= V_DataMax Then Exit Do
If V_DataPos + 6000 > V_DataMax then T = Space(V_DataMax - V_DataPos + 1)
Get #V_FNID, V_DataPos, T
V_DataPos += Len(T)
V_Data += T
End If
If Len(V_Data) < 4 Then Exit Do
XType = V_Data[0] or (V_Data[1] shl 8) or(V_Data[2] shl 16) or (V_Data[3] shl 24)
V_Data = Mid(V_Data, 5)
Select Case XType
Case 0
Exit Do
Case XTV
XRV = LL_INT_Item_LLDataParse(V_FNID, RV_LL->V_ChildF, RV_LL->V_ChildL, RV_LF, V_Root, V_DataMax, V_DataPos, V_Data)
If XRV <> 0 Then Return XRV
Case LL_DT_LL
Case LL_DT_String
If Len(V_Data) < 4 Then Exit Select
L2 = V_Data[0] or (V_Data[1] shl 8) or(V_Data[2] shl 16) or (V_Data[3] shl 24)
If (Len(V_Data) - 4) < L2 Then
V_Data = Chr(L2 and 255) & Chr((L2 shr 8) and 255) & Chr((L2 shr 16) and 255) & Chr((L2 shr 24) and 255) & V_Data
Exit Select
End If
With *LL_INT_Item_Add(RV_LF, RV_LL, V_Parent, V_Root)
.V_DataType = XType
.V_Data = Mid(V_Data, 5, L2)
End With
V_Data = Mid(V_Data, L2 + 5)
Case LL_DT_UInteger, LL_DT_Integer
If Len(V_Data) < 4 Then Exit Select
L2 = V_Data[0] or (V_Data[1] shl 8) or(V_Data[2] shl 16) or (V_Data[3] shl 24)
With *LL_INT_Item_Add(RV_LF, RV_LL, V_Parent, V_Root)
.V_DataType = XType
.V_DataX = L2
End With
V_Data = Mid(V_Data, 5)
End Select
Loop
Return 0
End Function
'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
'###################################################################################################################################
Type LinkedList
LLPtr as LL_INT_LinkedList Ptr
Declare Function Item (V_Index as UInteger) as LinkedList
Declare Function Index () as UInteger
Declare Function DataType () as LL_DataType
Declare Function Count () as UInteger
Declare Property Text () as String
Declare Property Text (as String)
Declare Property UNum () as UInteger
Declare Property UNum (as UInteger)
Declare Property Num () as Integer
Declare Property Num (as Integer)
Declare Property AnyData () as Any Ptr
Declare Property AnyData (as Any Ptr)
Declare Function Add Overload (V_String as String, V_Index as UInteger = 0) as LinkedList
Declare Function Add Overload (V_UInteger as UInteger, V_Index as UInteger = 0) as LinkedList
Declare Function Add Overload (V_Integer as Integer, V_Index as UInteger = 0) as LinkedList
Declare Function Add Overload (V_AnyPtr as Any Ptr, V_Index as UInteger = 0) as LinkedList
Declare Sub Del (V_Index as UInteger)
Declare Sub Clear ()
Declare Function SaveLL (V_PathFile as String, V_WithSubTree as Byte = 1) as Integer
Declare Function LoadLL (V_PathFile as String) as Integer
Declare Function SaveXML (V_PathFile as String, V_WithSubTree as Byte = 1) as Integer
Declare Function LoadXML (V_PathFile as String) as Integer
End Type
'###################################################################################################################################
Private Function LinkedList.Item(V_Index as UInteger) as LinkedList
Dim TLL as LinkedList
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return TLL
#ELSE
If This.LLPtr = 0 Then Return TLL
#ENDIF
Dim TLPtr as LL_INT_LinkedList Ptr = LL_INT_Item_Get(This.LLPtr->V_ChildF, V_Index)
TLL.LLPtr = TLPtr
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
Return TLL
#ENDIF
Return TLL
End Function
'###################################################################################################################################
Private Property LinkedList.Text() as String
If This.LLPtr = 0 Then Return ""
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_String Then MutexUnLock(LL_INT_Mutex): Return ""
Dim T as String = This.LLPtr->V_Data
MutexUnLock(LL_INT_Mutex)
Return T
#ELSE
If This.LLPtr->V_DataType <> LL_DT_String Then Return ""
Return This.LLPtr->V_Data
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.Text(V_Value as String)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_String Then MutexUnLock(LL_INT_Mutex): Exit Property
This.LLPtr->V_Data = V_Value
MutexUnLock(LL_INT_Mutex)
#ELSE
If This.LLPtr->V_DataType <> LL_DT_String Then Exit Property
This.LLPtr->V_Data = V_Value
#ENDIF
End Property
'-----------------------------------------------------------------------------------------------------------------------------------
Private Property LinkedList.UNum() as UInteger
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_UInteger Then MutexUnLock(LL_INT_Mutex): Return 0
Dim T as UInteger = This.LLPtr->V_DataX
MutexUnLock(LL_INT_Mutex)
Return T
#ELSE
If This.LLPtr->V_DataType <> LL_DT_UInteger Then Return 0
Return This.LLPtr->V_DataX
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.UNum(V_Value as UInteger)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_UInteger Then MutexUnLock(LL_INT_Mutex): Exit Property
This.LLPtr->V_DataX = V_Value
MutexUnLock(LL_INT_Mutex)
#ELSE
If This.LLPtr->V_DataType <> LL_DT_UInteger Then Exit Property
This.LLPtr->V_DataX = V_Value
#ENDIF
End Property
'-----------------------------------------------------------------------------------------------------------------------------------
Private Property LinkedList.Num() as Integer
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_Integer Then MutexUnLock(LL_INT_Mutex): Return 0
Dim T as Integer = Cast(Integer, This.LLPtr->V_DataX)
MutexUnLock(LL_INT_Mutex)
Return T
#ELSE
If This.LLPtr->V_DataType <> LL_DT_Integer Then Return 0
Return Cast(Integer, This.LLPtr->V_DataX)
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.Num(V_Value as Integer)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_Integer Then MutexUnLock(LL_INT_Mutex): Exit Property
This.LLPtr->V_DataX = Cast(UInteger, V_Value)
MutexUnLock(LL_INT_Mutex)
#ELSE
If This.LLPtr->V_DataType <> LL_DT_Integer Then Exit Property
This.LLPtr->V_DataX = Cast(UInteger, V_Value)
#ENDIF
End Property
'-----------------------------------------------------------------------------------------------------------------------------------
Private Property LinkedList.AnyData() as Any Ptr
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_AnyPtr Then MutexUnLock(LL_INT_Mutex): Return 0
Dim T as Any Ptr = Cast(Any Ptr, This.LLPtr->V_DataX)
MutexUnLock(LL_INT_Mutex)
Return T
#ELSE
If This.LLPtr->V_DataType <> LL_DT_AnyPtr Then Return 0
Return Cast(Any Ptr, This.LLPtr->V_DataX)
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.AnyData(V_Value as Any Ptr)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr->V_DataType <> LL_DT_AnyPtr Then MutexUnLock(LL_INT_Mutex): Exit Property
This.LLPtr->V_DataX = Cast(UInteger, V_Value)
MutexUnLock(LL_INT_Mutex)
#ELSE
If This.LLPtr->V_DataType <> LL_DT_AnyPtr Then Exit Property
This.LLPtr->V_DataX = Cast(UInteger, V_Value)
#ENDIF
End Property
'###################################################################################################################################
Private Function LinkedList.Add Overload (V_String as String, V_Index as UInteger = 0) as LinkedList
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
#ENDIF
Dim TLL as LinkedList
If This.LLPtr = 0 Then This.LLPtr = CAllocate(SizeOf(LL_INT_LinkedList))
Dim TLPtr as LL_INT_LinkedList Ptr
If This.LLPtr->V_Parent <> 0 Then
TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr->V_Root, V_Index)
Else: TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr, V_Index)
End If
#IFDEF LL_DEF_ThreadSafe
If TLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return TLL
#ELSE
If TLPtr = 0 Then Return TLL
#ENDIF
TLPtr->V_DataType = LL_DT_String
TLPtr->V_Data = V_String
TLL.LLPtr = TLPtr
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return TLL
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.Add Overload (V_UInteger as UInteger, V_Index as UInteger = 0) as LinkedList
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
#ENDIF
Dim TLL as LinkedList
If This.LLPtr = 0 Then This.LLPtr = CAllocate(SizeOf(LL_INT_LinkedList))
Dim TLPtr as LL_INT_LinkedList Ptr
If This.LLPtr->V_Parent <> 0 Then
TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr->V_Root, V_Index)
Else: TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr, V_Index)
End If
#IFDEF LL_DEF_ThreadSafe
If TLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return TLL
#ELSE
If TLPtr = 0 Then Return TLL
#ENDIF
TLPtr->V_DataType = LL_DT_UInteger
TLPtr->V_DataX = V_UInteger
TLL.LLPtr = TLPtr
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return TLL
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.Add Overload (V_Integer as Integer, V_Index as UInteger = 0) as LinkedList
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
#ENDIF
Dim TLL as LinkedList
If This.LLPtr = 0 Then This.LLPtr = CAllocate(SizeOf(LL_INT_LinkedList))
Dim TLPtr as LL_INT_LinkedList Ptr
If This.LLPtr->V_Parent <> 0 Then
TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr->V_Root, V_Index)
Else: TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr, V_Index)
End If
#IFDEF LL_DEF_ThreadSafe
If TLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return TLL
#ELSE
If TLPtr = 0 Then Return TLL
#ENDIF
TLPtr->V_DataType = LL_DT_Integer
TLPtr->V_DataX = Cast(UInteger, V_Integer)
TLL.LLPtr = TLPtr
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return TLL
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.Add Overload (V_AnyPtr as Any Ptr, V_Index as UInteger = 0) as LinkedList
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
#ENDIF
Dim TLL as LinkedList
If This.LLPtr = 0 Then This.LLPtr = CAllocate(SizeOf(LL_INT_LinkedList))
Dim TLPtr as LL_INT_LinkedList Ptr
If This.LLPtr->V_Parent <> 0 Then
TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr->V_Root, V_Index)
Else: TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr, V_Index)
End If
#IFDEF LL_DEF_ThreadSafe
If TLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return TLL
#ELSE
If TLPtr = 0 Then Return TLL
#ENDIF
TLPtr->V_DataType = LL_DT_AnyPtr
TLPtr->V_DataX = Cast(UInteger, V_AnyPtr)
TLL.LLPtr = TLPtr
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return TLL
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LinkedList.Del(V_Index as UInteger)
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Exit Sub
#ELSE
If This.LLPtr = 0 Then Exit Sub
#ENDIF
LL_INT_Item_Del(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, V_Index)
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
End Sub
'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LinkedList.Clear()
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Exit Sub
#ELSE
If This.LLPtr = 0 Then Exit Sub
#ENDIF
LL_INT_Item_Clear(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL)
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
End Sub
'###################################################################################################################################
Private Function LinkedList.Index() as UInteger
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
If This.LLPtr->V_Parent = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
Dim C as UInteger = LL_INT_Item_GetIndex(This.LLPtr->V_Parent->V_ChildF, This.LLPtr)
MutexUnLock(LL_INT_Mutex)
Return C
#ELSE
If This.LLPtr = 0 Then Return 0
If This.LLPtr->V_Parent = 0 Then Return 0
Return LL_INT_Item_GetIndex(This.LLPtr->V_Parent->V_ChildF, This.LLPtr)
#ENDIF
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.Count() as UInteger
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
Dim C as UInteger = LL_INT_Item_Count(This.LLPtr->V_ChildF)
MutexUnLock(LL_INT_Mutex)
Return C
#ELSE
If This.LLPtr = 0 Then Return 0
Return LL_INT_Item_Count(This.LLPtr->V_ChildF)
#ENDIF
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.DataType() as LL_DataType
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
Dim C as LL_DataType = This.LLPtr->V_DataType
MutexUnLock(LL_INT_Mutex)
Return C
#ELSE
If This.LLPtr = 0 Then Return 0
Return This.LLPtr->V_DataType
#ENDIF
End Function
'###################################################################################################################################
Private Function LinkedList.SaveXML(V_PathFile as String, V_WithSubTree as Byte = 1) as Integer
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
#ELSE
If This.LLPtr = 0 Then Return 0
#ENDIF
If dir(V_PathFile, -1) <> "" Then Kill V_PathFile
Dim XFNID as Integer = FreeFile
If Open(V_PathFile for Binary as #XFNID) <> 0 Then
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 1
End If
Print #XFNID, "<LL>"
LL_INT_Item_TreePut(XFNID, LL_SF_XML, V_WithSubTree, This.LLPtr)
Print #XFNID, "</LL>"
Close #XFNID
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 0
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.LoadXML(V_PathFile as String) as Integer
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
#ENDIF
If This.LLPtr <> 0 Then LL_INT_Item_Clear(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL)
If This.LLPtr = 0 Then This.LLPtr = CAllocate(SizeOf(LL_INT_LinkedList))
If dir(V_PathFile, -1) = "" Then Return 1
Dim XFNID as Integer = FreeFile
If Open(V_PathFile for Binary as #XFNID) <> 0 Then
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 1
End If
'LL_INT_Item_XMLDataParse(XFNID, This.LLPtr, Lof(XFNID))
Close #XFNID
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 0
End Function
'###################################################################################################################################
Private Function LinkedList.SaveLL(V_PathFile as String, V_WithSubTree as Byte = 1) as Integer
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
#ELSE
If This.LLPtr = 0 Then Return 0
#ENDIF
If dir(V_PathFile, -1) <> "" Then Kill V_PathFile
Dim XFNID as Integer = FreeFile
If Open(V_PathFile for Binary as #XFNID) <> 0 Then
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 1
End If
LL_INT_Item_TreePut(XFNID, LL_SF_LL, V_WithSubTree, This.LLPtr->V_ChildF)
Close #XFNID
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 0
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.LoadLL(V_PathFile as String) as Integer
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
#ENDIF
If This.LLPtr <> 0 Then LL_INT_Item_Clear(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL)
If This.LLPtr = 0 Then This.LLPtr = CAllocate(SizeOf(LL_INT_LinkedList))
If dir(V_PathFile, -1) = "" Then Return 1
Dim XFNID as Integer = FreeFile
If Open(V_PathFile for Binary as #XFNID) <> 0 Then
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 1
End If
LL_INT_Item_LLDataParse(XFNID, This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, 0, This.LLPtr->V_ChildF, Lof(XFNID))
Close #XFNID
#IFDEF LL_DEF_ThreadSafe
MutexUnLock(LL_INT_Mutex)
#ENDIF
Return 0
End Function
'###################################################################################################################################
Public Sub LL_Destroy(V_LL as LinkedList)
#IFDEF LL_DEF_ThreadSafe
MutexLock(LL_INT_Mutex)
If V_LL.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Exit Sub
LL_INT_Item_Clear(V_LL.LLPtr->V_ChildF, V_LL.LLPtr->V_ChildL)
DeAllocate(V_LL.LLPtr)
V_LL.LLPtr = 0
MutexUnLock(LL_INT_Mutex)
#ELSE
If V_LL.LLPtr = 0 Then Exit Sub
LL_INT_Item_Clear(V_LL.LLPtr->V_ChildF, V_LL.LLPtr->V_ChildL)
DeAllocate(V_LL.LLPtr)
V_LL.LLPtr = 0
#ENDIF
End Sub