Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Split text to array very fast
| Uploader: |  marpon |
| Datum/Zeit: | 23.01.2013 09:56:34 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts CSED_FB multi-language Windows IDE for FreeBasic, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'Slit Text in array(base0)
'
'usage :
'
'Dim nb as integer ' return nb of elements
'Dim TEXT As String, DELIMIT As String
'Dim RET() As String ' dynamic array
'
' nb = Split( TEXT, DELIMIT, RET())
'
'in ret(0) you will have the number of elements as string
'the first element is in ret(1)
Function Split( TEXT As String, DELIMIT As String, RET() As String) As Integer
'' note that this function assignes the memory for the array to the first pointer
'' so freeing this pointer frees the full array.
'
Dim As Integer DMAX=0
Dim RES() As ZString Ptr
Dim As Integer I1 , I2, ini, fini
Dim As ZString Ptr p , p1 , p2, p3
Dim As Integer LDelimit = Len(DELIMIT), LT= Len(TEXT)
Dim As Integer Posi()
If LT=0 Or LDelimit > LT Then
ReDim RET(1)
RET(0) = "0"
DMAX=0
Return DMAX
Exit Function
EndIf
' count the delimiters
p = StrPtr(TEXT)
p1=p
If LDelimit>0 Then ' au moins 1 caractère en délimiter
Do While *p
I2=0
If *p = DELIMIT[0] Then
p3=p
If LDelimit>1 Then 'plus d'1 caractère en délimiter
For I1 = 1 To LDelimit-1
I2=0
p+=1
If *p <> DELIMIT[I1] Then Exit For
I2=1
Next
Else
I2=1
EndIf
If I2=1 Then
If p= StrPtr(TEXT)+LT-1 Then fini=1 ' fini avec le délimiter
DMAX+=1
ReDim Preserve Posi(0 To DMAX-1)
Posi(DMAX-1)=p3 - p1 +1
EndIf
EndIf
p+=1
Loop
If DMAX=0 And ini=0 Then ' aucun délimiter trouvé
DMAX=1
ReDim RET(2)
RET(0) = "1"
RET(1) = TEXT ' copy the full text
Return DMAX
Exit Function
ElseIf DMAX=0 And ini=1 Then ' debut avec délimiter trouvé
DMAX=1
ReDim RET(2)
RET(0) = "1"
RET(1) = Mid(TEXT,LDelimit+1)
Return DMAX
Exit Function
EndIf
' dimention the array and assign memory to first element
If fini=0 Then DMAX+=1
ReDim RET(0 To DMAX)
ReDim RES(0 To DMAX-1)
'msgbox Str$(DMAX)
RES(0) = Allocate(Len(TEXT)+1)
*RES(0) = TEXT ' copy the full text
' step through the string, setting pointers for each element and null terminating
p = RES(0)
'msgbox "DMAX = " & *RES(0) ,"p = " & Str$(p)
'
For I1 = 0 To DMAX-2
p2= p + Posi(I1) -1
'msgbox "I1 = " & Str$(I1) & " Posi(I1) " & Str$(Posi(I1)) & " (ini * LDelimit) " & Str$(ini * LDelimit) ,"p2 = " & Str$(p2)
*p2 = 0 ' null terminate each element
RES(I1+1) = p2 + LDelimit ' set pointer to next element
RET(I1+1)=*RES(I1)
'msgbox RET(I1)
Next
If fini=1 Then
p2= p+Posi(DMAX-1)-1
'p2= p - LDelimit + 1
*p2 = 0
EndIf
RET(DMAX)=*RES(DMAX-1)
RET(0) = Str$(DMAX)
' msgbox RET(DMAX-1)
Deallocate RES(0)
Else
ReDim RET(2)
RET(0) = "1"
RET(1) = TEXT ' copy the full texte
DMAX=1
EndIf
Return DMAX
End Function