added Stringfield BF to the tests
The longer the string the quicker the alternative methods will be compared to the native StringField function but for short strings the inbuilt function is fine.Array=398ms
List=525ms
Next=657ms
BF=1321ms
PB=1909ms
Len = 928 reps 10000
Code: Select all
EnableExplicit
DeclareModule StringFields_BF
EnableExplicit
; Main function - Call firstly
; Start index :
; 0 = Add a separator at the first
; 1 = first index
; -1 = Add a virtual separator at the end
; -2 = Add a virtual separator at the first and the end
Declare StringFields_BF(string$, ; String to parse - Adress - set so @string$
separator$, ; Separator
start_index=1, ; Start index
end_index=-1, ; Index up to which is searched - -1 = full string size, all
ignore_empty_fields=1) ; Ignore empty fields
; Child funktions - call at the first the main function
Declare.s GetStringFields_BF(field) ; Get a selected StringField
Declare GetAmountStringFields_BF() ; Get the StringFields amount
Declare GetEmptyStringFields_BF() ; Get the empty StringFields amount
Declare FreeAllStringFields_BF() ; Free the actual cached StringField list
Declare SortStringFields_BF(flags.a=0, ; Flags - (optional) - #PB_Sort_Ascending, #PB_Sort_Descending, #PB_Sort_NoCase
start_field=-1, ; Start field for sort - Ignore with -1
end_field=-1) ; End field for sort - Ignore with -1
; Find a string in a StringField
; This function give back the Stringfield number or 0
Declare FindStringFields_BF(find_string$, ; Search string
start_position=1, ; Startposition inside a StringField
flag.a=#PB_String_CaseSensitive, ; Flag - #PB_String_CaseSensitive (preset), #PB_String_NoCase
start_field=-1, ; Ignore with -1
end_field=-1) ; Ignore with -1
EndDeclareModule
Module StringFields_BF
Global NewList index() : AddElement(index())
Global NewList indexes.s() : AddElement(indexes())
Global empty_fields, skip_first, skip_
Procedure StringFields_BF(string$, separator$, start_index=1, end_index=-1, ignore_empty_fields=1)
; StringField_Tool_BF - By Saki - Unicode - This code is free for using and enhancing
Select start_index
Case 0 : Protected add_first=1 : Case -1 : Protected add_last=1 : Case -2 : add_first=1 : add_last=1
EndSelect
start_index=1
Protected i, ii, iii, iiii, pos_1, pos_2, length_result, comp, count_index, amount_indexes
Protected len_separator=StringByteLength(separator$), skip_first, skip_last, *string=@string$
Protected *separator=@separator$, *pointer.word, jump_in, byte_pos_last, result$
If end_index<0 : end_index=$FFFFFFF : EndIf
If end_index=0 : ProcedureReturn 0 : EndIf
If start_index>end_index : start_index=end_index : EndIf
If Not PeekW(*string) : ProcedureReturn 0 : EndIf
ClearList(index()) : AddElement(index())
ClearList(indexes()) : AddElement(indexes())
If comp=CompareMemory(*string, *separator, len_separator)
end_index+1 : count_index+1 : skip_first=1
EndIf
If add_first
If skip_first And start_index : start_index-2 : end_index-1: EndIf
Else
If skip_first And start_index : start_index-1 : EndIf
EndIf
i=-2
Repeat
i+2
comp=CompareMemory(*string+i, *separator, len_separator)
If comp
iii=i
count_index+1
jump_in=0 : ii+1 : i+len_separator-2 : amount_indexes+1
AddElement(index()) : index()=i+2
EndIf
*pointer=*string+i+len_separator
Until count_index>end_index Or Not *pointer\w
iiii=i
byte_pos_last=iii+len_separator
If comp=CompareMemory(*string+i-len_separator-1, *separator, len_separator)
skip_last=1
EndIf
If end_index>count_index : end_index=count_index : EndIf
amount_indexes=ii : i=skip_first
If start_index>amount_indexes : start_index=amount_indexes-1 : EndIf
i+start_index+skip_first+skip_last
If skip_first : i-1 : EndIf
If skip_last : i-1 : EndIf
If amount_indexes
Repeat
If ListSize(index())>i
SelectElement(index(), i) : pos_1=index()
EndIf
If ListSize(index())>i+1
SelectElement(index(), i+1) : pos_2=index()
EndIf
length_result=pos_2-pos_1-len_separator
If pos_2-pos_1>0
If length_result>0
result$=Space(length_result>>1)
CopyMemory(*string+pos_1, @result$, length_result)
AddElement(indexes())
indexes()=result$
Else
empty_fields+1
If ignore_empty_fields
result$=#Null$
Else
result$=""
AddElement(indexes())
EndIf
EndIf
EndIf
skip_first=0 : i+1
Until i>end_index Or i=amount_indexes
If add_last And skip_last
result$=Space((iiii-byte_pos_last+len_separator)/2)
CopyMemory(*string+byte_pos_last, @result$, iiii-byte_pos_last+len_separator)
AddElement(indexes()) : indexes()=result$
EndIf
EndIf
ProcedureReturn 1
EndProcedure
Procedure.s GetStringFields_BF(field)
If field <1 : ProcedureReturn "" : EndIf
SelectElement(indexes(), field)
If field<ListSize(indexes())
ProcedureReturn indexes()
EndIf
EndProcedure
Procedure GetAmountStringFields_BF()
ProcedureReturn ListSize(indexes())-1
EndProcedure
Procedure GetEmptyStringFields_BF()
ProcedureReturn empty_fields+skip_first
EndProcedure
Procedure FreeAllStringFields_BF()
ClearList(index())
AddElement(index())
ClearList(indexes())
AddElement(indexes())
empty_fields=0
ProcedureReturn 1
EndProcedure
Procedure SortStringFields_BF(flags.a=0, start_field=-1, end_field=-1)
If start_field>0 And end_field>1 And end_field<=ListSize(indexes())
SortList(indexes(), flags, start_field, end_field-1)
ProcedureReturn 2
Else
SortList(indexes(), flags)
ProcedureReturn 1
EndIf
EndProcedure
Procedure FindStringFields_BF(find_string$,
start_position=1,
flag.a=#PB_String_CaseSensitive,
start_field=-1,
end_field=-1)
Protected i, result$
If end_field>ListSize(indexes()) : end_field=ListSize(indexes()) : EndIf
If start_field>0 And end_field>1
end_field-1
For i=start_field To end_field
SelectElement(indexes(), i) : result$=indexes()
If FindString(result$, find_string$, start_position, flag)
ProcedureReturn i
EndIf
Next
EndIf
ProcedureReturn 0
EndProcedure
EndModule
UseModule StringFields_BF
Procedure StringField_List(*source,List StringFields.s(),separator=' ')
Protected *inp.Character
ClearList(StringFields())
If *source
*inp = *source
While *inp\c <> 0
While (*inp\c <> separator And *inp\c <> 0)
*inp+2
Wend
AddElement(StringFields())
StringFields()= PeekS(*source,(*inp-*source)>>1)
If *inp\c <> 0
*inp+2
*source = *inp
Else
Break
EndIf
Wend
EndIf
ProcedureReturn ListSize(StringFields())
EndProcedure
Procedure StringField_Array(*source,Array StringFields.s(1),separator=' ')
Protected *inp.Character,count=0
ReDim StringFields(256)
If *source
*inp = *source
While *inp\c <> 0
While (*inp\c <> separator And *inp\c <> 0 )
*inp+2
Wend
If ArraySize(StringFields()) < count
ReDim StringFields(count+8)
EndIf
StringFields(count) = PeekS(*source,(*inp-*source)>>1)
count+1
If *inp\c <> 0
*inp+2
*source = *inp
Else
Break
EndIf
Wend
EndIf
count - 1
ReDim StringFields(count)
ProcedureReturn count
EndProcedure
;Infratec's method will be better for long strings
Procedure.s GetNextStringField(*String, Separator$="", Init.i=#False)
Static *LastPosition, *Separator.Character, SeparatorLength.i
Protected *CurrentPosition.Character, *TestPosition.Character, Result$
Result$ = #EOT$
If Init
If *Separator
FreeMemory(*Separator)
EndIf
SeparatorLength = StringByteLength(Separator$)
*Separator = AllocateMemory(SeparatorLength, #PB_Memory_NoClear)
PokeS(*Separator, Separator$, -1, #PB_Unicode|#PB_String_NoZero)
*LastPosition = *String
EndIf
If *LastPosition
*CurrentPosition = *LastPosition - 2
If SeparatorLength = 2
Repeat
*CurrentPosition + 2
If *Separator\c = *CurrentPosition\c
Result$ = PeekS(*LastPosition, (*CurrentPosition - *LastPosition) / SizeOf(Character))
*LastPosition = *CurrentPosition + 2
Break
EndIf
*TestPosition = *CurrentPosition + 2
Until *TestPosition\c = 0
Else
Repeat
*CurrentPosition + 2
If CompareMemory(*Separator, *CurrentPosition, SeparatorLength)
Result$ = PeekS(*LastPosition, (*CurrentPosition - *LastPosition) / SizeOf(Character))
*LastPosition = *CurrentPosition + SeparatorLength
Break
EndIf
*TestPosition = *CurrentPosition + SeparatorLength
Until *TestPosition\c = 0
EndIf
If *TestPosition\c = 0 And *LastPosition < *CurrentPosition
Result$ = PeekS(*LastPosition, (*CurrentPosition - *LastPosition) / SizeOf(Character) + SeparatorLength)
*LastPosition = #Null
EndIf
EndIf
ProcedureReturn Result$
EndProcedure
Define string1.s = "Hello I am a splitted string "
Define string2.s = "Hello,I,am,a,splitted,string"
Define str.s = ""
Define Dim ar.s(255)
Define NewList ls.s()
Define reps = 10000
Define st,et,et1,et2,et3,et4,a,b,count
CompilerIf #PB_Compiler_Debugger
count = StringField_Array(@string1,ar())
For a = 0 To count
Debug ar(a)
Next
Define NewList ls.s()
count = StringField_List(@string2,ls(),',')
ForEach ls()
Debug ls()
Next
count = CountString(string1," ")
For a = 1 To count
Debug StringField(string1,a," ")
Next
Debug GetNextStringField(@string1," ", #True)
Repeat
str = GetNextStringField(@string1)
If str <> #EOT$
Debug str
EndIf
Until str = #EOT$
StringFields_BF(string1," ",0)
count = GetAmountStringFields_BF()
For b = 1 To count
Debug GetStringFields_BF(b)
Next
CompilerElse
For a = 1 To 5
string1 + string1
Next
st = ElapsedMilliseconds()
For a = 1 To reps
count = StringField_List(@string1,ls())
ForEach ls()
str = ls()
Next
Next
et = ElapsedMilliseconds()
For a = 1 To reps
count = StringField_Array(@string1,ar())
For b = 0 To count
str = ar(b)
Next
Next
et1=ElapsedMilliseconds()
For a = 1 To reps
str = GetNextStringField(@string1," ", #True)
Repeat
str = GetNextStringField(@string1)
Until str = #EOT$
Next
et2 = ElapsedMilliseconds()
For a = 1 To reps
count = CountString(string1," ")+1
For b= 1 To count
str = StringField(string1,b," ")
Next
Next
et3 = ElapsedMilliseconds()
For a = 1 To reps
StringFields_BF(string1," ",0)
count = GetAmountStringFields_BF()
For b = 1 To count
str = GetStringFields_BF(b)
Next
FreeAllStringFields_BF()
Next
et4 = ElapsedMilliseconds()
Define out.s = " Array=" + Str(et1-et) + "ms " + #CRLF$ +
" List=" + Str(et-st) + "ms " + #CRLF$ +
" Next=" + Str(et2-et1) + "ms " + #CRLF$ +
" BF=" + Str(et4-et3) + "ms " + #CRLF$ +
" PB=" + Str(et3-et2) + "ms " + #CRLF$ +
" Len = " + Len(string1) + " reps " + Str(reps)
SetClipboardText(out)
MessageRequester("string fields test",out)
CompilerEndIf