J'ai un problème avec un AllocateMemory().
Le debugger me dit : Invalide Memory Access.
Ma ligne où ça bug est la suivante :
Code : Tout sélectionner
*mem = AllocateMemory(Size) ; avec Size=12Le fichier est le suivant :
Code : Tout sélectionner
;IncludeFile "Res.pb4"
;/-------------------------\
;- Constantes
;\-------------------------/
#Vector_ErrorTitle = "UserLib Vector Error"
#Vector_Flag_Allocated = $4AB3 ; a fixed random value
#Vector_CurrentElement = -2 ; Default value for empty parameter in Select, Add, Delete Functions
#Vector_EmptyParameter = -500
;{- Type Enumeration
; Kind of vector : differents types
#Complex = -1 ; Use this constants to define another type
; #Byte = 0
; #Word = 1
; #Long = 2
; #Float = 3
; #Quad = 4
; #String = 5
; #Double = 6
#Vector_Type_Minimum = #Complex
#Vector_Type_Maximum = #Double
;}
;{- Sort Enumeration
; Sort and comparaisons
#Vector_Sort_Downward = $20
#Vector_Sort_CaseNotSensitive = $40 ; For Strings
;{- EncType Enumeration
; String encodage
#Vector_Compare_Ascii = $00
#Vector_Compare_UTF8 = $01
#Vector_Compare_Unicode = $02
;}
;}
;{- Comparator Enumeration
; comparaisons
#Vector_Compare_Less = -1
#Vector_Compare_Equal = 0
#Vector_Compare_More = 1
;}
;{- ScanDirectory Enumeration
#Vector_Dir_Recursive = 1
#Vector_Dir_KeepFolder = 2
;}
;/-------------------------\
;- Structures
;\-------------------------/
;{- Structure VNode
; VNode Structure (Vector Nodes)
; Object who contains the pointer to the Data
Structure VNode
*Value ; Address of the Element
*NextElement.VNode ; Pointer to the next element
*PreviousElement.VNode ; Pointer to the previous element
EndStructure
;}
;{- Structure Vector
; Vector Structure
; Main Object : contains information about the linked list
Structure Vector
Initilized.w ; Flag for beeing sure that the Vector is allocated
Type.w ; Kind of Vector
*Constructor ; Address of the constructor function
*Destructor ; Address of the destructor function
*CurrentElement.VNode ; Pointer to the current element
Index.l ; Index of the current element
*FirstElement.VNode ; Pointer to the first element of the Vector
*LastElement.VNode ; Pointer to the last element of the Vector
Count.l ; Number of element in this vector
*Comparator ; Pointer to the comparate function
Mutex.l ; Create a Mutex for ThreadSafe Vector
EndStructure
;}
;{- Others Structures
Structure VectorScan Extends Vector
ThreadID.l
Stop.b
EndStructure
Structure Vector_Dir_Infos
Name.s
Size.q
Type.l
Attributes.l
CreationDate.l
AccessedDate.l
ModifiedDate.l
EndStructure
Structure Vector_Dir_Params
*Vector.VectorScan
Path.s
Options.l
Extensions.s
EndStructure
;}
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
#PATH_DELIMITER = "\"
CompilerDefault
#PATH_DELIMITER = "/"
; This include Mac, Linux and Amiga OS
; But I don't know if it's true...
CompilerEndSelect
Global NewList Vector__GarbageCollector()
;/------------------------------------------\
;| |
;- Privates Functions
;| |
;\------------------------------------------/
;{- Vector__RaiseError
; Local Function for displaying errors
; When this function is called, the program will be exiting
Procedure Vector__RaiseError(Message$, Function$ = #NULL$, Flag.l = #MB_ICONERROR)
Protected _title$
If Function$
_title$ = #Vector_ErrorTitle + " - " + Function$ + "()"
Else
_title$ = #Vector_ErrorTitle
EndIf
MessageRequester(_title$, Message$, Flag)
End
EndProcedure
;}
;{- Vector__IsInitialized (Macro)
; Test if the Vector has been created
; Otherwise the program will be quiting with an error
Macro Vector__IsInitialized(vector, FunctionName)
If vector = #Null
Vector__RaiseError("Try to use Vector Functions from Null Pointer !", FunctionName)
ElseIf vector\Initilized <> #Vector_Flag_Allocated
Vector__RaiseError("Vector is not initialized !", FunctionName)
EndIf
EndMacro
;}
;{- Vector__IsType (Macro)
; Test if the Vector has been created and if his Type is correct
; Otherwise the program will be quiting with an error
Macro Vector__IsType(vector, type_, FunctionName)
Vector__IsInitialized(vector, FunctionName)
If vector\Type <> type_
Vector__RaiseError("Not good type !", FunctionName)
EndIf
EndMacro
;}
;{- Vector__Allocate : Vector AllocateMemory
; If Can't return a Null Pointer, because the 'Exception' is catched
Procedure.l Vector__Allocate(Size.l)
Protected *mem
Debug Size
*mem = AllocateMemory(Size)
If *mem = #Null
Vector__RaiseError("Can't allocate memory")
EndIf
ProcedureReturn *mem
EndProcedure
;}
;{- Vector__GetNextVNode + Vector__GetPreviousVNode
; Just the Next or Previous Element, or Null if *node=#Null
Procedure Vector__GetNextVNode(*node.VNode)
If *node
ProcedureReturn *node\NextElement
EndIf
EndProcedure
Procedure Vector__GetPreviousVNode(*node.VNode)
If *node
ProcedureReturn *node\PreviousElement
EndIf
EndProcedure
;}
;{- Vector__NextElement + Vector__PreviousElement + Vector_W_NextElement + Vector_W_PreviousElement
; Change the CurrentElement by the Next or Previous
; Becarefull : Their must be a CurrentElement
Macro Vector__NextElement(vector)
vector\CurrentElement = vector\CurrentElement\NextElement
vector\Index + 1
EndMacro
Macro Vector_W_NextElement()
\CurrentElement = \CurrentElement\NextElement
\Index + 1
EndMacro
Macro Vector__PreviousElement(vector)
vector\CurrentElement = vector\CurrentElement\PreviousElement
vector\Index - 1
EndMacro
Macro Vector_W_PreviousElement()
\CurrentElement = \CurrentElement\PreviousElement
\Index - 1
EndMacro
;}
Macro Vector__SaveContext(vector_, memory_)
memory_ = Vector__Allocate(SizeOf(Vector))
CopyMemory(vector_, memory_, SizeOf(Vector))
EndMacro
Macro Vector__RestoreContext(vector_, memory_)
CopyMemory(memory_, vector_, SizeOf(Vector))
EndMacro
;/------------------------------------------\
;| |
;- Constructors and Destructor Functions
;| |
;\------------------------------------------/
;{- V__Constructor_xxx : String, Byte, Long, Double, etc...
; The differents constructors
; For Complex Structures, users have to define their own constructor
; If the argument is not a Null Pointer, the pointed object is copied to the new memory
; Otherelse for numbers an empty memory is allocated, for Strings the pointer is Null
Procedure.l V__Constructor_Byte(*param.Byte = #Null)
Protected *mem.Byte
*mem = Vector__Allocate(SizeOf(Byte))
If *param
*mem\b = *param\b
EndIf
ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Word(*param.Word = #Null)
Protected *mem.Word
*mem = Vector__Allocate(SizeOf(Word))
If *param
*mem\w = *param\w
EndIf
ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Long(*param.Long = #Null)
Protected *mem.Long
*mem = Vector__Allocate(SizeOf(Long))
If *param
*mem\l = *param\l
EndIf
ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Float(*param.Float = #Null)
Protected *mem.Float
*mem = Vector__Allocate(SizeOf(Float))
If *param
*mem\f = *param\f
EndIf
ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Quad(*param.Quad = #Null)
Protected *mem.Quad
*mem = Vector__Allocate(SizeOf(Quad))
If *param
*mem\q = *param\q
EndIf
ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_String_Ex(*param = #Null)
Protected *str.String, *mem.String, *buff, *char.Byte
CompilerIf Defined(Vector_UseStringPtr, #PB_Constant)
If *param
*str = @*param
*mem = Vector__Allocate(Len(*str\s)+1)
*mem\s = *str\s
ElseIf _Vector_SafeString
*mem = Vector__Allocate(1)
*mem\s = ""
EndIf
CompilerElse
If *param
*str = @*param
*mem = Vector__Allocate(Len(*str\s)+1)
*buff = *mem
CopyMemoryString(*str\s, @*buff)
ElseIf _Vector_SafeString
*char = Vector__Allocate(1)
*char\b = 0
*mem = *char
Debug PeekS(*mem)
EndIf
CompilerEndIf
ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_String(*param = #Null)
Protected *str.String, *mem.String
If *param
*str = @*param
*mem = Vector__Allocate(SizeOf(String))
*mem\s = *str\s
Else
*mem = Vector__Allocate(1)
*mem\s = ""
EndIf
ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Double(*param.Double = #Null)
Protected *mem.Double
*mem = Vector__Allocate(SizeOf(Double))
If *param
*mem\d = *param\d
EndIf
ProcedureReturn *mem
EndProcedure
;}
;{- V__BasicDestructor
; Destructor of basic types (not Structures)
ProcedureDLL V__BasicDestructor(*param)
EndProcedure
;}
;/------------------------------------------\
;| |
;- Comparators Functions
;| |
;\------------------------------------------/
;{- V__Comparator_xxx : String, Byte, Long, Double, etc...
; The differents comparators
; For Complex Structures, users have to define their own coparators
Procedure V__Comparator_Byte(*obj1.Byte, *obj2.Byte)
If *obj1\b = *obj2\b
ProcedureReturn #Vector_Compare_Equal
ElseIf *obj1\b < *obj2\b
ProcedureReturn #Vector_Compare_Less
Else
ProcedureReturn #Vector_Compare_More
EndIf
EndProcedure
Procedure V__Comparator_Word(*obj1.Word, *obj2.Word)
If *obj1\w = *obj2\w
ProcedureReturn #Vector_Compare_Equal
ElseIf *obj1\w < *obj2\w
ProcedureReturn #Vector_Compare_Less
Else
ProcedureReturn #Vector_Compare_More
EndIf
EndProcedure
Procedure V__Comparator_Long(*obj1.Long, *obj2.Long)
If *obj1\l = *obj2\l
ProcedureReturn #Vector_Compare_Equal
ElseIf *obj1\l < *obj2\l
ProcedureReturn #Vector_Compare_Less
Else
ProcedureReturn #Vector_Compare_More
EndIf
EndProcedure
Procedure V__Comparator_Float(*obj1.Float, *obj2.Float)
If *obj1\f = *obj2\f
ProcedureReturn #Vector_Compare_Equal
ElseIf *obj1\f < *obj2\f
ProcedureReturn #Vector_Compare_Less
Else
ProcedureReturn #Vector_Compare_More
EndIf
EndProcedure
Procedure V__Comparator_Quad(*obj1.Quad, *obj2.Quad)
If *obj1\q = *obj2\q
ProcedureReturn #Vector_Compare_Equal
ElseIf *obj1\q < *obj2\q
ProcedureReturn #Vector_Compare_Less
Else
ProcedureReturn #Vector_Compare_More
EndIf
EndProcedure
Procedure V__Comparator_StringCaseSensitive(*obj1.String, *obj2.String)
ProcedureReturn CompareMemoryString(@*obj1\s, @*obj2\s, #True)
EndProcedure
Procedure V__Comparator_String(*obj1.String, *obj2.String)
ProcedureReturn CompareMemoryString(@*obj1\s, @*obj2\s, #False)
EndProcedure
Procedure V__Comparator_Double(*obj1.Double, *obj2.Double)
If *obj1\d = *obj2\d
ProcedureReturn #Vector_Compare_Equal
ElseIf *obj1\d < *obj2\d
ProcedureReturn #Vector_Compare_Less
Else
ProcedureReturn #Vector_Compare_More
EndIf
EndProcedure
;}
;/------------------------------------------\
;| |
;- Get/Set Functions
;| |
;\------------------------------------------/
ProcedureDLL Vector_Count(*vector.Vector) ; Count Nodes
Vector__IsInitialized(*vector, "Vector_Count")
ProcedureReturn *vector\Count
EndProcedure
ProcedureDLL Vector_Index(*vector.Vector) ; Position
Vector__IsInitialized(*vector, "Vector_Index")
ProcedureReturn *vector\Count
EndProcedure
ProcedureDLL Vector_GetCurrentElement(*vector.Vector) ; Current Element
Vector__IsInitialized(*vector, "Vector_CurrentElement")
ProcedureReturn *vector\CurrentElement
EndProcedure
ProcedureDLL Vector_GetFirstElement(*vector.Vector) ; Firts Element
Vector__IsInitialized(*vector, "Vector_GetFirstElement")
ProcedureReturn *vector\FirstElement
EndProcedure
ProcedureDLL Vector_GetLastElement(*vector.Vector) ; Last Element
Vector__IsInitialized(*vector, "Vector_GetLastElement")
ProcedureReturn *vector\LastElement
EndProcedure
ProcedureDLL Vector_SetCaseSensitiveState(*Vector.Vector, State.l)
Vector__IsInitialized(*vector, "Vector_SetCaseSensitiveState")
If *Vector\Type = #String
If State
*Vector\Constructor = @V__Comparator_StringCaseSensitive()
Else
*Vector\Constructor = @V__Constructor_String()
EndIf
Else
Vector__RaiseError("This is not a String Vector", "Vector_SetCaseSensitiveState")
EndIf
EndProcedure
;/------------------------------------------\
;| |
;- Moves Functions
;| |
;\------------------------------------------/
ProcedureDLL Vector_FirstElement(*vector.Vector)
Vector__IsInitialized(*vector, "Vector_FirstElement")
With *vector
WaitForSingleObject_(\Mutex,0)
\CurrentElement = \FirstElement
\Index = 0
ReleaseMutex_(\Mutex)
ProcedureReturn \CurrentElement
EndWith
EndProcedure
ProcedureDLL Vector_LastElement(*vector.Vector)
Vector__IsInitialized(*vector, "Vector_LastElement")
With *vector
WaitForSingleObject_(\Mutex,0)
\CurrentElement = \LastElement
\Index = \Count - 1
ReleaseMutex_(\Mutex)
ProcedureReturn \CurrentElement
EndWith
EndProcedure
ProcedureDLL Vector_NextElement(*vector.Vector)
Vector__IsInitialized(*vector, "Vector_NextElement")
With *vector
WaitForSingleObject_(\Mutex,0)
If \Count And \Index = -1
\CurrentElement = \FirstElement
\Index = 0
ElseIf \CurrentElement
Vector_W_NextElement()
EndIf
ReleaseMutex_(\Mutex)
ProcedureReturn \CurrentElement
EndWith
EndProcedure
ProcedureDLL Vector_PreviousElement(*vector.Vector)
Vector__IsInitialized(*vector, "Vector_PreviousElement")
With *vector
WaitForSingleObject_(\Mutex,0)
If \Count = \Index
\CurrentElement = \LastElement
\Index - 1
ElseIf \CurrentElement
Vector_W_PreviousElement()
EndIf
ReleaseMutex_(\Mutex)
ProcedureReturn \CurrentElement
EndWith
EndProcedure
ProcedureDLL Vector_Reset(*vector.Vector)
Vector__IsInitialized(*vector, "Vector_Reset")
With *vector
WaitForSingleObject_(\Mutex,0)
\CurrentElement = #Null
\Index = -1
ReleaseMutex_(\Mutex)
ProcedureReturn \CurrentElement
EndWith
EndProcedure
ProcedureDLL Vector_SelectElement(*vector.Vector, Index.l, FonctionName.s = #NULL$)
Protected dist.l, index_.l, *node_.VNode
If FonctionName = #NULL$
FonctionName = "Vector_SelectElement"
EndIf
Vector__IsInitialized(*vector, FonctionName)
With *vector
WaitForSingleObject_(\Mutex,0)
If Index < 0 Or Index >= \Count
Vector__RaiseError("Invalid Index for Vector_Select()", FonctionName)
EndIf
dist = Abs(\Index - Index)
If dist > Index
;Debug "Search from the begin !"
dist = Index
\Index = 0
\CurrentElement = \FirstElement
EndIf
If dist > \Count - Index
;Debug "Search from the end !"
\Index = \Count - 1
\CurrentElement = \LastElement
EndIf
While \Index <> Index
;Debug "Index : " + Str(\Index)
If \Index < Index
Vector_W_NextElement()
Else
Vector_W_PreviousElement()
EndIf
Wend
ReleaseMutex_(\Mutex)
ProcedureReturn \CurrentElement
EndWith
EndProcedure
;/------------------------------------------\
;| |
;- Get/Set Functions
;| |
;\------------------------------------------/
ProcedureDLL Vector_Get(*vector.Vector, Index.l = #Vector_CurrentElement)
Vector__IsInitialized(*vector, "Vector_Get")
If Index <> #Vector_CurrentElement
Vector_SelectElement(*vector, Index, "Vector_Get")
EndIf
If *vector\CurrentElement
ProcedureReturn *vector\CurrentElement\Value
Else
Vector__RaiseError("The current element is a Null Pointer !", "Vector_Get")
EndIf
EndProcedure
ProcedureDLL Vector_Set(*vector.Vector, *Object = #Null, Index.l = #Vector_CurrentElement)
Vector__IsInitialized(*vector, "Vector_Get")
If Index <> #Vector_CurrentElement
Vector_SelectElement(*vector, Index, "Vector_Get")
EndIf
With *vector
WaitForSingleObject_(\Mutex,0)
If *vector\CurrentElement
CallFunctionFast(\Destructor, \CurrentElement\Value)
\CurrentElement\Value = CallFunctionFast(\Constructor, *Object)
Else
Vector__RaiseError("Null Pointer !", "Vector_Get")
EndIf
ReleaseMutex_(\Mutex)
EndWith
EndProcedure
ProcedureDLL Vector_SwapElements(*vector.Vector, Index1.l, Index2.l)
Protected *node.VNode, index.l, *node1.VNode, *node2.VNode, temp
Vector__IsInitialized(*vector, "Vector_SwapElements")
If Index1 <> Index2
With *vector
WaitForSingleObject_(\Mutex,0)
*node = \CurrentElement
index = \Index
*node1 = Vector_SelectElement(*vector, Index1, "Vector_Swap")
*node2 = Vector_SelectElement(*vector, Index2, "Vector_Swap")
If *node1 And *node2
temp = *node1\Value
*node1\Value = *node2\Value
*node2\Value = temp
EndIf
\CurrentElement = *node
\Index = index
ReleaseMutex_(\Mutex)
EndWith
EndIf
EndProcedure
ProcedureDLL Vector_SetComparator(*vector.Vector, Function)
WaitForSingleObject_(*vector\Mutex,0)
Vector__IsInitialized(*vector, "Vector_SetComparator")
*vector\Comparator = Function
ReleaseMutex_(*vector\Mutex)
EndProcedure
ProcedureDLL Vector_GetComparator(*vector.Vector)
Vector__IsInitialized(*vector, "Vector_SetComparator")
ProcedureReturn *vector\Comparator
EndProcedure
;/------------------------------------------\
;| |
;- Vector Constructor/Destructor
;| |
;\------------------------------------------/
;{- Vector_Create
; Create a Vector from a given Type
; If the Type is known, Constructor and Destructor will be ignored
; Otherwise, this 2 arguments are pointer to the Constructor and Destructor Functions
ProcedureDLL Vector__Create(Type.w, Constructor = #Null, Destructor = #Null, Comparator = #Null)
Protected *vector.Vector
*vector = Vector__Allocate(SizeOf(Vector))
With *vector
\Initilized = #Vector_Flag_Allocated
If Type < #Vector_Type_Minimum Or Type > #Vector_Type_Maximum
Vector__RaiseError("Incorrect Type value", "Vector_Create")
EndIf
\Type = Type
\Destructor = @V__BasicDestructor()
Select Type
Case #Complex
\Constructor = Constructor
\Destructor = Destructor
\Comparator = Comparator
Case #Byte
\Constructor = @V__Constructor_Byte()
\Comparator = @V__Comparator_Byte()
Case #Word
\Constructor = @V__Constructor_Word()
\Comparator = @V__Comparator_Word()
Case #Long
\Constructor = @V__Constructor_Long()
\Comparator = @V__Comparator_Long()
Case #Float
\Constructor = @V__Constructor_Float()
\Comparator = @V__Comparator_Float()
Case #Quad
\Constructor = @V__Constructor_Quad()
\Comparator = @V__Comparator_Quad()
Case #String
\Constructor = @V__Constructor_String()
\Comparator = @V__Comparator_StringCaseSensitive() ; @V__Comparator_String()
Case #Double
\Constructor = @V__Constructor_Double()
\Comparator = @V__Comparator_Double()
EndSelect
\Count = 0
\Index = -1
\FirstElement = #Null
\LastElement = #Null
\CurrentElement = #Null
\Mutex = CreateMutex_(0,0,0)
EndWith
AddElement(Vector__GarbageCollector()) : Vector__GarbageCollector() = *vector
ProcedureReturn *vector
EndProcedure
Macro Vector_CreateFromStructure(Constructor, Destructor, Comparator = #Null)
Vector__Create(#Complex, Constructor, Destructor, Comparator)
EndMacro
Macro Vector_CreateFromStruct(Constructor, Destructor, Comparator = #Null)
Vector__Create(#Complex, Constructor, Destructor, Comparator)
EndMacro
Macro Vector_Create(Type_)
Vector__Create(Type_)
EndMacro
;}
;{- Vector_Clear
; Delete all nodes
ProcedureDLL.l Vector_Clear(*vector.Vector)
Protected *cNode.VNode, *nNode.VNode
Vector__IsInitialized(*vector, "Vector_Clear")
With *vector
WaitForSingleObject_(\Mutex,0)
*cNode = *vector\FirstElement
While *cNode
*nNode = *cNode\NextElement
CallFunctionFast(\Destructor, *cNode\Value)
*cNode = *nNode
Wend
\Count = 0
\Index = -1
\FirstElement = #Null
\LastElement = #Null
ReleaseMutex_(\Mutex)
EndWith
EndProcedure
;}
;{- Vector_Free
; FreeMemory for the Vector and his Nodes
ProcedureDLL.l Vector_Free(*vector.Vector)
Vector__IsInitialized(*vector, "Vector_Free")
Vector_Clear(*vector)
*vector\Initilized = #Null
CloseHandle_(*vector\Mutex)
ForEach Vector__GarbageCollector()
If Vector__GarbageCollector() = *vector
DeleteElement(Vector__GarbageCollector())
Break
EndIf
Next
FreeMemory(*vector)
EndProcedure
;}
;{- Vector_FreeGarbageCollector
; Clear all Vector who haven't been cleared !!!
ProcedureDLL Vector_FreeGarbageCollector()
ForEach Vector__GarbageCollector()
Vector_Free(Vector__GarbageCollector())
Next
ClearList(Vector__GarbageCollector())
EndProcedure
;}
;/------------------------------------------\
;| |
;- Add/Delete Functions
;| |
;\------------------------------------------/
;{- Vector_AddElement (after the Current/New Element)
ProcedureDLL Vector_AddElement(*vector.Vector, *object = #Null, Index.l = #Vector_CurrentElement)
Protected *new.VNode
Vector__IsInitialized(*vector, "Vector_AddElement")
If Index <> #Vector_CurrentElement
Vector_SelectElement(*vector, Index, "AddElement")
EndIf
With *vector
WaitForSingleObject_(\Mutex,0)
*new = Vector__Allocate(SizeOf(VNode))
*new\Value = CallFunctionFast(\Constructor, *object)
*new\PreviousElement = #Null
*new\NextElement = #Null
If *vector\Count = 0 ; Add the firts Element
\FirstElement = *new
\LastElement = *new
\Index = 0
ElseIf \Index = -1 ; Add at head of list
*new\NextElement = \FirstElement
\FirstElement\PreviousElement = *new
\FirstElement = *new
\Index = 0
ElseIf \Index >= \Count-1 ; Add at end of list
*new\PreviousElement = \LastElement
\LastElement\NextElement = *new
\LastElement = *new
\Index = \Count
Else ; In the list
*new\PreviousElement = \CurrentElement
*new\NextElement = \CurrentElement\NextElement
\CurrentElement\NextElement\PreviousElement = *new
\CurrentElement\NextElement = *new
\Index + 1
EndIf
\Count + 1
\CurrentElement = *new
ReleaseMutex_(\Mutex)
EndWith
ProcedureReturn *new
EndProcedure
;}
;{- Vector_DeleteElement (the Current/Selected Element)
ProcedureDLL Vector_DeleteElement(*vector.Vector, Index.l = #Vector_CurrentElement)
Protected *cNode.VNode
Vector__IsInitialized(*vector, "Vector_AddElement")
If Index <> #Vector_CurrentElement
Vector_SelectElement(*vector, Index, "AddElement")
EndIf
With *vector
WaitForSingleObject_(\Mutex,0)
If \CurrentElement = #Null
Vector__RaiseError("There is no current element", "Vector_DelElement")
EndIf
*cNode = \CurrentElement
If *cNode\NextElement
*cNode\NextElement\PreviousElement = *cNode\PreviousElement
EndIf
If *cNode\PreviousElement
*cNode\PreviousElement\NextElement = *cNode\NextElement
EndIf
\CurrentElement = *cNode\PreviousElement
\Index - 1
\Count - 1
;Debug *cNode
;Debug *cNode\Value
CallFunctionFast(\Destructor, *cNode\Value)
FreeMemory(*cNode\Value)
FreeMemory(*cNode)
ReleaseMutex_(\Mutex)
EndWith
EndProcedure
;}
;/------------------------------------------\
;| |
;- Sort Functions
;| |
;\------------------------------------------/
Procedure Vector__QS_Swap(*vector.Vector, iMin.l, iMax.l, opt.l)
Protected temp, *min.VNode, *max.VNode, test1.b, test2.b
If opt & #Vector_Sort_Downward
test1 = -1: test2 = 1
Else
test1 = 1: test2 = -1
EndIf
*max = Vector_SelectElement(*vector, iMax)
temp = *max\Value
*min = Vector_SelectElement(*vector, iMin)
With *vector
While (iMax > iMin)
While iMax > iMin And CallFunctionFast(\Comparator, *min\Value, temp) <> test1
iMin + 1
\CurrentElement = \CurrentElement\NextElement
\Index + 1
*min = \CurrentElement
Wend
If iMax > iMin
*max\Value = *min\Value
\CurrentElement = *max
\Index = iMax
*max = Vector_PreviousElement(*vector): iMax - 1
While iMax > iMin And CallFunctionFast(\Comparator, *max\Value, temp) <> test2
iMax - 1
\CurrentElement = \CurrentElement\PreviousElement
\Index - 1
*max = \CurrentElement
;*max = Vector_Prev(*vector)
Wend
If iMax > iMin
*min\Value = *max\Value
\CurrentElement = *min
\Index = iMin
\CurrentElement = \CurrentElement\NextElement
\Index + 1
*min = \CurrentElement
;*min = Vector_Next(*vector)
iMin + 1
EndIf
EndIf
Wend
EndWith
*max\Value = temp
ProcedureReturn iMax
EndProcedure
Procedure Vector__QS_Split(*vector.Vector, deb.l, fin.l, opt.l)
Protected mil.l
If deb < fin
mil = Vector__QS_Swap(*vector, deb, fin, opt)
If mil-deb > fin-mil
Vector__QS_Split(*vector, mil+1, fin, opt)
Vector__QS_Split(*vector, deb, mil-1, opt)
Else
Vector__QS_Split(*vector, deb, mil-1, opt)
Vector__QS_Split(*vector, mil+1, fin, opt)
EndIf
EndIf
EndProcedure
ProcedureDLL Vector_SortOnRange(*vector.Vector, options.l, debut.l, fin.l)
Vector__IsInitialized(*vector, "Vector_Sort")
Vector_SortString_CaseNotSentitive_ = (options & #Vector_Sort_CaseNotSensitive)
With *vector
\CurrentElement = \FirstElement
\Index = 0
Vector__QS_Split(*vector, debut, fin, opt)
\CurrentElement = \FirstElement
\Index = 0
EndWith
EndProcedure
ProcedureDLL Vector_Sort(*vector.Vector, options.l = #Null)
Vector__IsInitialized(*vector, "Vector_Sort")
Vector_SortOnRange(*vector, options, 0, *vector\Count - 1)
EndProcedure
;/------------------------------------------\
;| |
;- Search Functions
;| |
;\------------------------------------------/
ProcedureDLL Vector_Search(*vector.Vector, *element, *index.Long = #Null)
Protected *backup, index.l = -1
Vector__IsInitialized(*vector, "Vector_Search")
If *vector\Comparator = #Null
Vector__RaiseError("No comparator defined !", "Vector_Search")
EndIf
Vector__SaveContext(*vector, *backup)
Vector_Reset(*vector)
While index = -1 And Vector_NextElement(*vector)
If CallFunctionFast(*vector\Comparator, *vector\CurrentElement\Value, *element) = 0
index = *vector\Index
EndIf
Wend
Vector__RestoreContext(*vector, *backup)
If *index
*index\l = index
EndIf
If index > 1
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
;/------------------------------------------\
;| |
;- Others Functions
;| |
;\------------------------------------------/
ProcedureDLL Vector_Copy(*original.Vector)
Protected *vector.Vector, *backup
Vector__IsInitialized(*original, "Vector_Copy")
Vector__SaveContext(*original, *backup)
*vector = Vector_Create(*original\Type)
*vector\Constructor = *original\Constructor
*vector\Destructor = *original\Destructor
Vector_Reset(*original)
While Vector_NextElement(*original)
Vector_AddElement(*vector, *original\CurrentElement\Value)
Wend
Vector__RestoreContext(*original, *backup)
ProcedureReturn *vector
EndProcedure
ProcedureDLL Vector_Combine(*source.Vector, *destination.Vector)
Protected *backup
Vector__IsInitialized(*source, "Vector_Combine")
Vector__IsInitialized(*destination, "Vector_Combine")
If *destination\Constructor = *source\Constructor And *destination\Destructor = *source\Destructor And *destination\Type = *source\Type
Vector__SaveContext(*source, *backup)
Vector_Reset(*source)
While Vector_NextElement(*source)
Vector_AddElement(*vector, *source\CurrentElement\Value)
Wend
Vector__RestoreContext(*source, *backup)
Else
Vector__RaiseError("Incompatibles Vectors !", "Vector_Combine")
EndIf
EndProcedure
;/------------------------------------------\
;| |
;- Directory Functions
;| |
;\------------------------------------------/
Procedure Vector__NextDirectoryEntry(hDir.l)
Protected Type.l, Name$
If NextDirectoryEntry(hDir)
Type = DirectoryEntryType(hDir)
If Type = #PB_DirectoryEntry_Directory
Name$ = DirectoryEntryName(hDir)
If Name$ = "." Or Name$ = ".."
ProcedureReturn Vector__NextDirectoryEntry(hDir)
EndIf
EndIf
ProcedureReturn Type
Else
ProcedureReturn #Null
EndIf
EndProcedure
Procedure Vector__ScanDir(*Vector.VectorScan, Dir$, SecondDirPart$, options.l, ext$)
Protected hDir.l, FileName$, Type.l, CompleteName$
hDir = ExamineDirectory(#PB_Any, Dir$+SecondDirPart$, "*.*")
If hDir
Type = Vector__NextDirectoryEntry(hDir)
While Type And *Vector\Stop = #Null
FileName$ = DirectoryEntryName(hDir)
Debug FileName$
CompleteName$ = SecondDirPart$ + FileName$
If Type = #PB_DirectoryEntry_File
If ext$ = ";;"
Vector_AddElement(*Vector, @CompleteName$)
ElseIf FindString(ext$, ";"+LCase(GetExtensionPart(FileName$))+";", 1)
Vector_AddElement(*Vector, @CompleteName$)
EndIf
Else
If options & #Vector_Dir_KeepFolder
Vector_AddElement(*Vector, @CompleteName$)
EndIf
If options & #Vector_Dir_Recursive
Vector__ScanDir(*Vector, Dir$, CompleteName$+#PATH_DELIMITER, options, ext$)
EndIf
EndIf
; Debug Dir$ + DirectoryEntryName(hDir) + Type$ + "- Taille en octet : " + Str(DirectoryEntrySize(hDir))
Type = Vector__NextDirectoryEntry(hDir)
Wend
FinishDirectory(hDir)
Else
Debug "Can't examine directory : " + Dir$
EndIf
EndProcedure
Procedure Vector_ThreadScanDir(*params.Vector_Dir_Params)
Vector__ScanDir(*params\Vector, *params\Path, "", *params\Options, *params\Extensions)
*params\Vector\ThreadID = #Null
FreeMemory(*params)
EndProcedure
; extensions$ : list of used extensions délimited by ";"
; Return Null Pointer, if path not exist
ProcedureDLL Vector_ScanDirectory(Directory$, options.l = #Null, extensions$ = #NULL$)
Protected *param.Vector_Dir_Params
If FileSize(Directory$) = -2
If Right(Directory$, 1) <> #PATH_DELIMITER
Directory$ + #PATH_DELIMITER
EndIf
*param = AllocateMemory(SizeOf(Vector_Dir_Params))
*param\Vector = Vector_Create(#String)
*param\Path = Directory$
*param\Options = options
*param\Extensions = extensions$
Debug *param\Vector
*param\Vector\ThreadID = CreateThread(@Vector_ThreadScanDir(), *param)
;Vector__ScanDir(*Vector, Directory$, "", options, ";"+LCase(extensions$)+";")
Else
Vector__RaiseError("Folder doesn't exists !", "Vector_ScanDirectory")
EndIf
ProcedureReturn *param\Vector
EndProcedure
ProcedureDLL Vector_ScanDirectory_Finished(*vector.VectorScan)
Vector__IsInitialized(*vector, "Vector_ScanDirectory_Finished")
If *vector\ThreadID = #Null
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
ProcedureDLL Vector_ScanDirectory_Stop(*vector.VectorScan)
Vector__IsInitialized(*vector, "Vector_ScanDirectory_Stop")
*vector\Stop = #True
EndProcedure
;/------------------------------------------\
;| |
;- String Functions
;| |
;\------------------------------------------/
ProcedureDLL Vector_Explode(String$, Separator$)
Protected *vector.Vector, i.l, chaine$
*vector = Vector_Create(#String)
For i = 1 To CountString(String$, Separator$)+1
chaine$ = StringField(String$, i, Separator$)
Vector_AddElement(*vector, @chaine$)
Next i
ProcedureReturn *vector
EndProcedure
ProcedureDLL.s Vector_Implode(*vector.Vector, Separator$)
Protected String$, *s.String
Vector__IsType(*vector, #String, "Vector_Implode")
Vector_Reset(*vector)
While Vector_NextElement(*vector)
*s = Vector_Get(*vector)
String$ + *s\s
If *vector\CurrentElement\NextElement
String$ + Separator$
EndIf
Wend
ProcedureReturn String$
EndProcedure
;/------------------------------------------\
;| |
;- Files Functions
;| |
;\------------------------------------------/
ProcedureDLL Vector_LoadByteFile(FileName$)
Protected *vector.Vector, hFile.l, value.b
hFile = OpenFile(#PB_Any, FileName$)
If hFile
*vector = Vector_Create(#Byte)
While Not(Eof(hFile))
value = ReadByte(hFile)
Vector_AddElement(*vector, @value)
Wend
CloseFile(hFile)
ProcedureReturn *vector
Else
ProcedureReturn #Null
EndIf
EndProcedure
ProcedureDLL Vector_LoadWordFile(FileName$)
Protected *vector.Vector, hFile.l, value.w
hFile = OpenFile(#PB_Any, FileName$)
If hFile
*vector = Vector_Create(#Word)
While Not(Eof(hFile))
value = ReadByte(hFile)
Vector_AddElement(*vector, @value)
Wend
CloseFile(hFile)
ProcedureReturn *vector
Else
ProcedureReturn #Null
EndIf
EndProcedure
ProcedureDLL Vector_LoadLongFile(FileName$)
Protected *vector.Vector, hFile.l, value.l
hFile = OpenFile(#PB_Any, FileName$)
If hFile
*vector = Vector_Create(#Byte)
While Not(Eof(hFile))
value = ReadLong(hFile)
Vector_AddElement(*vector, @value)
Wend
CloseFile(hFile)
ProcedureReturn *vector
Else
ProcedureReturn #Null
EndIf
EndProcedure
ProcedureDLL Vector_LoadStringFile(FileName$)
Protected *vector.Vector, hFile.l, line$
hFile = OpenFile(#PB_Any, FileName$)
If hFile
*vector = Vector_Create(#String)
While Not(Eof(hFile))
line$ = ReadString(hFile)
Vector_AddElement(*vector, @line$)
Wend
CloseFile(hFile)
ProcedureReturn *vector
Else
ProcedureReturn #Null
EndIf
EndProcedure
ProcedureDLL Vector_LoadQuadFile(FileName$)
Protected *vector.Vector, hFile.l, value.q
hFile = OpenFile(#PB_Any, FileName$)
If hFile
*vector = Vector_Create(#Byte)
While Not(Eof(hFile))
value = ReadQuad(hFile)
Vector_AddElement(*vector, @value)
Wend
CloseFile(hFile)
ProcedureReturn *vector
Else
ProcedureReturn #Null
EndIf
EndProcedure
ProcedureDLL Vector_LoadFloatFile(FileName$)
Protected *vector.Vector, hFile.l, value.f
hFile = OpenFile(#PB_Any, FileName$)
If hFile
*vector = Vector_Create(#Byte)
While Not(Eof(hFile))
value = ReadFloat(hFile)
Vector_AddElement(*vector, @value)
Wend
CloseFile(hFile)
ProcedureReturn *vector
Else
ProcedureReturn #Null
EndIf
EndProcedure
ProcedureDLL Vector_LoadDoubleFile(FileName$)
Protected *vector.Vector, hFile.l, value.d
hFile = OpenFile(#PB_Any, FileName$)
If hFile
*vector = Vector_Create(#Byte)
While Not(Eof(hFile))
value = ReadDouble(hFile)
Vector_AddElement(*vector, @value)
Wend
CloseFile(hFile)
ProcedureReturn *vector
Else
ProcedureReturn #Null
EndIf
EndProcedure
;/------------------------------------------\
;| |
;- Debug Functions
;| |
;\------------------------------------------/
Procedure Vector_Debug(*vector.Vector, spacer$ = #NULL$, number.b = #Null)
Protected nb, number$, *b.Byte, *w.Word, *l.Long, *f.Float, *q.Quad, *s.String, *d.Double
Vector__IsInitialized(*vector, "Vector_Debug")
If *vector\Type = #Complex
Vector__RaiseError("Can't Debug Complexe Type !", "Vector_Debug")
EndIf
If number
If *vector\Count
nb = Len(Str(*vector\Count-1))
Else
nb = 0
EndIf
EndIf
Vector_Reset(*Vector)
While Vector_NextElement(*Vector)
If number
number$ = spacer$ + LSet(Str(*Vector\Index), nb, "0") + ") "
Else
number$ = spacer$
EndIf
Select *vector\Type
Case #Byte
*b = Vector_Get(*Vector)
Debug number$ + Str(*b\b)
Case #Word
*w = Vector_Get(*Vector)
Debug number$ + Str(*w\w)
Case #Long
*l = Vector_Get(*Vector)
Debug number$ + Str(*l\l)
Case #Float
*f = Vector_Get(*Vector)
Debug number$ + StrF(*f\f)
Case #Quad
*q = Vector_Get(*Vector)
Debug number$ + StrQ(*q\q)
Case #String
*s = Vector_Get(*Vector)
Debug number$ + *s\s
Case #Double
*d = Vector_Get(*Vector)
Debug number$ + StrD(*d\d)
EndSelect
Wend
EndProcedure
;/------------------------------------------\
;| |
;- Macros
;| |
;\------------------------------------------/
Macro Vector_First(vector_)
Vector_FirstElement(vector_)
EndMacro
Macro Vector_Last(vector_)
Vector_LastElement(vector_)
EndMacro
Macro Vector_Next(vector_)
Vector_NextElement(vector_)
EndMacro
Macro Vector_Previous(vector_)
Vector_PreviousElement(vector_)
EndMacro
Macro Vector_Swap(vector_, Idx1_, Idx2_)
Vector_SwapElements(vector_, Idx1_, Idx2_)
EndMacro
Macro Vector_Add(vector_, object_ = #Null, index_ = #Vector_CurrentElement)
Vector_AddElement(vector_, object_, index_)
EndMacro
Macro Vector_AddAtStart(vector_, object_ = #Null)
Vector_AddElement(vector_, object_, -1)
EndMacro
ProcedureDLL Vector_AddAtEnd(*vector.Vector, *object = #Null)
Vector__IsInitialized(*vector, "Vector_AddAtEnd")
ProcedureReturn Vector_AddElement(*vector, *object, *vector\Count - 1)
EndProcedure
Macro Vector_Delete(vector_, index_ = #Vector_CurrentElement)
Vector_DeleteElement(vector_, index_)
EndMacro
Macro Vector_DeleteLastElement(vector_)
Vector__IsInitialized(vector_, "Vector_DeleteLastElement")
Vector_DeleteElement(vector_, vector_\Count - 1)
EndMacro
Macro Vector_DeleteFirstElement(vector_)
Vector_DeleteElement(vector_, -1)
EndMacro
Macro Vector_Del(vector_, index_ = #Vector_CurrentElement)
Vector_DeleteElement(vector_, index_)
EndMacro
Macro Vector_Select(vector_, index_, fctName_ = #NULL$)
Vector_SelectElement(vector_, index_, fctName_)
EndMacro
Macro Vector_Clone(vector_)
Vector_Copy(vector_)
EndMacro
; - EXEMPLE !!!!!!!!!!!!!!!!!!
IncludePath ".."
IncludeFile "Vector.pb4"
*ptr2.String
dir$ = "E:\Programmation\PureBasic\Projets\LIB\Lib Vector\Version2"
*Vector.VectorScan = Vector_ScanDirectory(dir$, 3, "")
While Not(Vector_ScanDirectory_Finished(*Vector))
Debug "wait..."
Delay(2)
Wend
Debug "------------"
; Affichage du contenu du Vector
Vector_Reset(*Vector)
While Vector_NextElement(*Vector)
*ptr2 = Vector_Get(*Vector)
Debug *ptr2\s
Wend
; Libération de la mémoire
Vector_Free(*Vector)
J'utilise PB version 4.10 beta
Lio
