Update v1.04
- Added function SplitStringList and SplitStringArray
Update v1.05
- Update SplitString: Minimal performance update
- Added SplitParameter: Public from EventDesigner
Update v1.06.2
- Added StringBetweenList
- Added StringBetweenArray
Code: Select all
;-TOP
; Comment : SplitString to list and array with option double-quotes
; Author : mk-soft
; Version : v1.06.2
; Create : 03.11.2017
; Update : 23.07.2022
; Link GR :
; Link EN : https://www.purebasic.fr/english/viewtopic.php?t=69557
; OS : All
; License : MIT
; ***************************************************************************************
Procedure SplitStringList(String.s, Separator.s, List Result.s(), DQuote = #False)
Protected *String.character, *Separator.character
Protected *Start, *End, exit, lock, do, dq, len
ClearList(Result())
*String = @String
*Separator = @Separator
*Start = *String
*End = *String
If DQuote
Repeat
If *String\c = 0
exit = #True
do = #True
If Not dq
*End = *String
EndIf
Else
If *String\c = '"'
If Not lock
lock = #True
dq = #True
*Start = *String + SizeOf(character)
Else
lock = #False
*End = *String
EndIf
EndIf
If *String\c = *Separator\c And Not lock
do = #True
If Not dq
*End = *String
EndIf
EndIf
EndIf
If do
AddElement(Result())
len = (*End - *Start) / SizeOf(character)
If Len > 0
Result() = PeekS(*Start, len)
EndIf
*Start = *String + SizeOf(character)
do = #False
dq = #False
EndIf
*String + SizeOf(character)
Until exit
Else
Repeat
If *String\c = 0
exit = #True
do = #True
*End = *String
Else
If *String\c = *Separator\c
do = #True
*End = *String
EndIf
EndIf
If do
AddElement(Result())
len = (*End - *Start) / SizeOf(character)
If Len > 0
Result() = PeekS(*Start, len)
EndIf
*Start = *String + SizeOf(character)
do = #False
EndIf
*String + SizeOf(character)
Until exit
EndIf
ProcedureReturn ListSize(Result())
EndProcedure
Procedure SplitStringArray(String.s, Separator.s, Array Result.s(1), DQuote = #False)
Protected *String.character, *Separator.character
Protected *Start, *End, exit, lock, do, dq, len , count, size
size = 7
Dim Result(size)
*String = @String
*Separator = @Separator
*Start = *String
*End = *String
If DQuote
Repeat
If *String\c = 0
exit = #True
do = #True
If Not dq
*End = *String
EndIf
Else
If *String\c = '"'
If Not lock
lock = #True
dq = #True
*Start = *String + SizeOf(character)
Else
lock = #False
*End = *String
EndIf
EndIf
If *String\c = *Separator\c And Not lock
do = #True
If Not dq
*End = *String
EndIf
EndIf
EndIf
If do
If size < count
size + 8
ReDim Result(size)
EndIf
len = (*End - *Start) / SizeOf(character)
If Len > 0
Result(count) = PeekS(*Start, len)
EndIf
*Start = *String + SizeOf(character)
count + 1
do = #False
dq = #False
EndIf
*String + SizeOf(character)
Until exit
Else
Repeat
If *String\c = 0
exit = #True
do = #True
*End = *String
Else
If *String\c = *Separator\c
do = #True
*End = *String
EndIf
EndIf
If do
If size < count
size + 8
ReDim Result(size)
EndIf
len = (*End - *Start) / SizeOf(character)
If Len > 0
Result(count) = PeekS(*Start, len)
EndIf
*Start = *String + SizeOf(character)
count + 1
do = #False
EndIf
*String + SizeOf(character)
Until exit
EndIf
ReDim Result(count - 1)
ProcedureReturn count
EndProcedure
; ----
Procedure SplitParameterList(String.s, List Result.s(), fc=#False)
Protected *String.character
Protected *Start, *End, exit, lock, do, len, temp.s, cnt
Protected level
ClearList(Result())
*String = @String
If *String = 0
ProcedureReturn 0
EndIf
*Start = *String
*End = *String
Repeat
If *String\c = 0
exit = #True
*End = *String
Else
If *String\c = '"'
If Not lock
lock = #True
Else
lock = #False
EndIf
EndIf
If Not lock
If *String\c = '('
If level = 0
If fc ; Get Functionname
AddElement(Result())
len = (*String - *Start) / SizeOf(character)
If Len > 0
temp = PeekS(*Start, len)
ReplaceString(temp, #TAB$, " ", #PB_String_InPlace)
temp = Trim(temp)
cnt = CountString(temp, " ")
If cnt
temp = StringField(temp, cnt + 1, " ")
EndIf
Result() = temp
EndIf
EndIf
*Start = *String + SizeOf(character)
EndIf
level + 1
ElseIf *String\c = ')'
level - 1
If level = 0
do = #True
exit = #True
*End = *String
EndIf
ElseIf *String\c = ',' And level = 1
do = #True
*End = *String
EndIf
EndIf
EndIf
If do
AddElement(Result())
len = (*End - *Start) / SizeOf(character)
If Len > 0
Result() = Trim(PeekS(*Start, len))
EndIf
*Start = *String + SizeOf(character)
do = #False
EndIf
*String + SizeOf(character)
Until exit
FirstElement(Result())
ProcedureReturn ListSize(Result())
EndProcedure
; ----
Procedure SplitParameterArray(String.s, Array Result.s(1))
Protected *String.character
Protected *Start, *End, exit, lock, do, len, temp.s, cnt, c1
Protected level
Dim Result(0)
*String = @String
If *String = 0
ProcedureReturn 0
EndIf
*Start = *String
*End = *String
c1 = 0
Repeat
If *String\c = 0
exit = #True
*End = *String
Else
If *String\c = '"'
If Not lock
lock = #True
Else
lock = #False
EndIf
EndIf
If Not lock
If *String\c = '('
If level = 0
If #True ; Get Functionname
len = (*String - *Start) / SizeOf(character)
If Len > 0
temp = PeekS(*Start, len)
ReplaceString(temp, #TAB$, " ", #PB_String_InPlace)
temp = Trim(temp)
cnt = CountString(temp, " ")
If cnt
temp = StringField(temp, cnt + 1, " ")
EndIf
Result(c1) = temp
EndIf
EndIf
*Start = *String + SizeOf(character)
EndIf
level + 1
ElseIf *String\c = ')'
level - 1
If level = 0
do = #True
exit = #True
*End = *String
EndIf
ElseIf *String\c = ',' And level = 1
do = #True
*End = *String
EndIf
EndIf
EndIf
If do
c1 + 1
If ArraySize(Result()) < c1
ReDim Result(c1 + 10)
EndIf
len = (*End - *Start) / SizeOf(character)
If Len > 0
Result(c1) = Trim(PeekS(*Start, len))
Else
Result(c1) = ""
EndIf
*Start = *String + SizeOf(character)
do = #False
EndIf
*String + SizeOf(character)
Until exit
ReDim Result(c1)
ProcedureReturn c1
EndProcedure
; ----
Procedure StringBetweenList(String.s, Left.s, Right.s, List Result.s())
Protected pos1, pos2, len1, len2
ClearList(Result())
len1 = Len(Left)
len2 = Len(Right)
Repeat
pos1 = FindString(String, Left, pos1)
If pos1
pos1 + len1
pos2 = FindString(String, Right, pos1)
If pos2
AddElement(Result())
Result() = Mid(String, pos1, pos2 - pos1)
pos1 = pos2 + len2
Else
Break
EndIf
Else
Break
EndIf
ForEver
ProcedureReturn ListSize(Result())
EndProcedure
; ----
Procedure StringBetweenArray(String.s, Left.s, Right.s, Array Result.s(1))
Protected pos1, pos2, len1, len2, size, count
Dim Result(0)
len1 = Len(Left)
len2 = Len(Right)
Repeat
pos1 = FindString(String, Left, pos1)
If pos1
pos1 + len1
pos2 = FindString(String, Right, pos1)
If pos2
If size < count
size + 8
ReDim Result(size)
EndIf
Result(count) = Mid(String, pos1, pos2 - pos1)
count + 1
pos1 = pos2 + len2
Else
Break
EndIf
Else
Break
EndIf
ForEver
If count > 0
ReDim Result(count - 1)
EndIf
ProcedureReturn count
EndProcedure
; ----
; v1.01.0, 25.08.2022
Procedure.s StringBefore(String.s, StringToFind.s, StartPosition = 1, Mode = #PB_String_CaseSensitive)
Protected r1.s, pos.i
pos = FindString(String, StringToFind, StartPosition, Mode)
If pos
r1 = Left(String, pos - 1)
EndIf
ProcedureReturn r1
EndProcedure
Procedure.s StringAfter(String.s, StringToFind.s, StartPosition = 1, Mode = #PB_String_CaseSensitive)
Protected r1.s, pos.i
pos = FindString(String, StringToFind, StartPosition, Mode)
If pos
pos + Len(StringToFind)
r1 = Mid(String, pos)
EndIf
ProcedureReturn r1
EndProcedure
; v1.03.3, 30.08.2022
Procedure.s TrimChars(String.s, ReplaceString.s = " ", FindChars.s = " ")
DisableDebugger
Protected result.s, firstFound, found, size_max, size_replace
Protected *result, *findChars, *c.Character, *fc.Character, *rc.character, *tc.character, *ofs
If Not Bool(String)
ProcedureReturn ""
EndIf
size_max = StringByteLength(String) + SizeOf(Character)
size_replace = StringByteLength(ReplaceString)
*result = AllocateMemory(size_max + size_replace, #PB_Memory_NoClear)
*rc = *result
*c = @String
*tc = @ReplaceString
*findChars = @FindChars
While *c\c
*fc = *findChars
While *fc\c
If *c\c = *fc\c
If Not firstFound
firstFound = #True
If *tc\c
CopyMemory(*tc, *rc, size_replace)
*rc + size_replace
If *rc - *result >= size_max
*ofs = *rc - *result
size_max = MemorySize(*result)
*result = ReAllocateMemory(*result, size_max + size_replace, #PB_Memory_NoClear)
*rc = *result + *ofs
EndIf
EndIf
EndIf
found = #True
Break
EndIf
*fc + SizeOf(Character)
Wend
If Not found
If firstFound : firstFound = #False : EndIf
*rc\c = *c\c
*rc + SizeOf(character)
Else
found = #False
EndIf
*c + SizeOf(Character)
Wend
*rc\c = 0
result = PeekS(*result)
FreeMemory(*result)
ProcedureReturn result
EnableDebugger
EndProcedure
; ***************************************************************************************
;-Examples
CompilerIf #PB_Compiler_IsMainFile
Global Dim a1.s(0)
Global NewList l1.s()
Global Dim p1.s(0)
Global NewList r1.s()
Global text.s, count
text = "0;1x;2xx;'Text with separator (;)';4xxxx;5xxxxx;'Text with linefeed " + #LF$ + "and separator (;)';End"
text = ReplaceString(text, "'", #DQUOTE$)
Debug "Text to List = " + text
Global count = SplitStringList(text, ";", l1(), #True)
Debug "Count = " + count
ForEach l1()
Debug "Index " + ListIndex(l1()) + " = [" + l1() + "]"
Next
Debug "--------"
Debug "Text to Array = " + text
Global count = SplitStringArray(text, ";", a1(), #True)
Debug "Count = " + count
For index = 0 To count - 1
Debug "Index " + index + " = [" + a1(index) + "]"
Next
Debug "--------"
text = "MyFunction (p1, p2, p3(1,2,3) ,p4,'10,20,30',r1,r2,r3(b1(x,y)),r4)"
text = ReplaceString(text, "'", #DQUOTE$)
Debug "Parameter to List = " + text
count = SplitParameterList(text, r1(), #True)
Debug "Count = " + count
ForEach r1()
Debug "Index " + ListIndex(r1()) + " = [" + r1() + "]"
Next
Debug "--------"
Debug "Parameter to Array = " + text
count = SplitParameterArray(text, p1())
Debug "Count = " + count
For index = 0 To count
Debug "Index " + index + " = [" + p1(index) + "]"
Next
Debug "--------"
text = "<title>Find me : title</title><title>Hello world!</title> Data 123456789 <title>Catch me</title><title>Error missing End"
Debug "StringBetweenList = " + text
count = StringBetweenList(text, "<title>", "</title>", r1())
Debug "Count = " + count
ForEach r1()
Debug "Index " + ListIndex(r1()) + " = [" + r1() + "]"
Next
Debug "--------"
Debug "StringBetweenArray = " + text
;text = "<title>Find me : title</title>"
count = StringBetweenArray(text, "<title>", "</title>", p1())
Debug "Count = " + count
For index = 0 To count - 1
Debug "Index " + index + " = [" + p1(index) + "]"
Next
Debug "--------"
text = "string_before keyword string_after"
Debug "StringBefore/After = " + text
Debug "Before: " + StringBefore(text, " keyword ")
Debug "After: " + StringAfter(text, " keyword ")
Debug "--------"
text = " " + #CRLF$ + #CRLF$ + " Hello World! " + #LFCR$ + #TAB$ + " "
Debug "TrimChars(text) = [" + TrimChars(text, " ", #CR$ + #LF$ + #TAB$ + " ") + "]"
text ="p u r e b a s i c"
Debug "TrimChars(text, '-') = [" + TrimChars(text, "-") + "]"
Debug "TrimChars(text, '') = [" + TrimChars(text, "") + "]"
Debug "--------"
CompilerEndIf