split( a as string ) as string() ?

[bluatigro]

i want to split a string into parts :
o = split( "a test of split" )
o( 1 ) => "a"
o( 2 ) => "test"
etc...

how do i do that in fb ?

[alfakilo]

deleted

[pestery]

Here's something I whipped up. Hope it helps.

Code: Select all

Declare Sub split(result() As String, ByRef source As String, ByRef search As String)

ReDim o() As String

Print "String is: 'a test of split'"
Print

split(o(), "a test of split", " ")
Print "Search for ' '"
For i As Integer = LBound(o) To UBound(o)
   Print "o(" & i & ") = '" & o(i) & "'"
Next
Print

split(o(), "a test of split", ",")
Print "Search for ','"
For i As Integer = LBound(o) To UBound(o)
   Print "o(" & i & ") = '" & o(i) & "'"
Next
Print

split(o(), "a test of split", "test")
Print "Search for 'test'"
For i As Integer = LBound(o) To UBound(o)
   Print "o(" & i & ") = '" & o(i) & "'"
Next
Print
Sleep

Sub split(result() As String, ByRef source As String, ByRef search As String)
   Dim As Integer i, j, count, length = Len(search)
   
   ' First pass, find out how many entries are needed
   count = 1
   i = InStr(source, search)
   If i = 0 Then
      ReDim result(1 To 1) As String
      result(1) = source
      Exit Sub
   EndIf
   While i > 0
      count += 1
      i = InStr(i + length, source, search)
   Wend
   
   ' Resize result array and fill
   ReDim result(1 To count) As String
   count = 1
   j = 1
   i = InStr(source, search)
   While i > 0
      result(count) = Mid(source, j, i - j)
      count += 1
      j = i + length
      i = InStr(i + length, source, search)
   Wend
   result(count) = Mid(source, j)
End Sub

[TJF]

In this code you can specify the characters that should be in your words:

Code: Select all

FUNCTION split(BYREF I AS UBYTE PTR) AS STRING
  VAR l = 0
  DO
    SELECT CASE AS CONST *I
    CASE 0 : EXIT DO

' add the characters you want to see in your words here
    CASE ASC("0") TO ASC("9"), ASC("A") TO ASC("Z"), ASC("a") TO ASC("z")
      l += 1

    CASE ELSE : IF l THEN EXIT DO
    END SELECT : I += 1
  LOOP : IF l THEN RETURN LEFT(*CAST(ZSTRING PTR, I - l), l)
  I = 0 : RETURN ""
END FUNCTION


' * Example how to use it
' ********************************
VAR t = "a test of split"
REDIM AS STRING o(-1 TO -1)

VAR i = UBOUND(o), p = SADD(t)
WHILE p
  i += 1
  REDIM PRESERVE o(i)
  o(i) = split(p)
WEND

FOR i AS INTEGER = 0 TO UBOUND(o)
  ?o(i)
NEXT

#IFNDEF __FB_UNIX__
SLEEP
#ENDIF

Note: The last STRING in o(0) is empty.

[bluatigro]

here is a try at it myself

error :
- code does not print anyting

Code: Select all

dim as string test = "this is a test ."
dim shared as string word( 40 )
declare sub split( a as string , cut as string = " ")
sub split( a as string , cut as string = " " )
  dim i as integer , tel as integer
  i = 1
  tel = 0
  while instr( a , cut ) <> 0
    i = instr( a , cut )
    word( tel ) = left( a , i )
    a = mid( a , i )
  wend
end sub
split test
dim i as integer , a as string
while word( i ) <> ""
  print word( i ) 
  i += 1
wend
input "[ pres return ]" ; a
  

[fxm]

See the comments of the three corrected lines:

Code: Select all

dim as string test = "this is a test ."
dim shared as string word( 40 )
declare sub split( a as string , cut as string = " ")
sub split( a as string , cut as string = " " )
  dim i as integer , tel as integer
  i = 1
  tel = 0
  while instr( a , cut ) <> 0
    i = instr( a , cut )
    word( tel ) = left( a , i )
    tel = tel + 1                 ' correction: to increment the array index
    a = mid( a , i + 1 )          ' correction: to skip the cutting caracter, otherwise infinite loop
  wend
  word( tel ) = a                 ' correction: to record the last sub-string
end sub
split test
dim i as integer , a as string
while word( i ) <> ""
  print word( i )
  i += 1
wend
input "[ pres return ]" ; a

[dodicat]

here's another:

Code: Select all

Sub split_string(s_in As String,char As String,result() As String)
        Dim As String s=s_in,var1,var2
        Dim As integer n,pst
        #macro split(stri,char,var1,var2)
        pst=Instr(stri,char)
        var1="":var2=""
        If pst<>0 Then
            var1=Mid(stri,1,pst-1)
            var2=Mid(stri,pst+1)
        Else
            var1=stri
            Endif
            Redim Preserve result(1 To 1+n-((Len(var1)>0)+(Len(var2)>0)))
            result(n+1)=var1
            #endmacro
            Do
                split(s,char,var1,var2):n=n+1:s=var2
            Loop Until var2=""
            Redim Preserve result(1 To Ubound(result)-1)
        End Sub
        
        
        dim as string s="A test of split again ."
        redim as string array()
       split_string(s," ",array())
       for z as integer=1 to ubound(array)
           print array(z)
       next z
    
       sleep
         

[MichaelW]

And another.

Code: Select all

''=============================================================================

function StrTok( byref searchStr as string, _
                  byref delimiterStr as string) as string

    ''-----------------------------------------------------------
    '' This function is a FreeBASIC version of the CRT strtok
    '' function. Unlike the CRT function, this function does not
    '' destroy the search string.
    ''
    '' Returns searchStr as a series of tokens (substrings).
    '' The tokens are separated in <searchStr> with one or more
    '' of the characters from <delimiterStr>. The first call
    '' returns the first token, or a null string if <searchStr>
    '' contains no tokens. Subsequent calls with <searchStr>
    '' set to a null string return any remaining tokens. A null
    '' string is returned when <searchStr> contains no more
    '' tokens. The characters in <delimiterStr> can be changed
    '' between calls.
    ''-----------------------------------------------------------

    static as string saveStr,c
    static as integer saveLength,startPos
    dim as integer tokLength

    if searchStr = "" then
        if saveStr = "" then exit function
    else
        saveStr = searchStr
        saveLength = len(saveStr)
        startPos = 1
    end if

    do while startPos + tokLength <= saveLength
        c = mid(saveStr, startPos + tokLength, 1)
        if instr(delimiterStr, c) then
            if tokLength then exit do
            startPos += 1
        else
            tokLength += 1
        end if
    loop

    StrTok = mid(saveStr, startPos, tokLength)

    startPos += tokLength

end function

''=============================================================================

dim as integer i
dim as string tok, s = "a test of strtok, strtok."

tok = StrTok(s," ,")  '' delimiters are space and comma
do while tok <> ""
    print tok
    i += 1
    tok = StrTok(""," ,")
loop
print i

sleep

Code: Select all

a
test
of
strtok
strtok.
 5

[xroot]

Here is a real simple one.....

Code: Select all

Sub Split(iTxt as string,iArr() as string,iDelim as string=" ")
    Dim as integer I,X
    For I=0 To Len(iTxt)-1
        If Chr(iTxt[I])=iDelim Then
            X+=1
            ReDim Preserve iArr(X)
        Else
            iArr(X)&=Chr(iTxt[I])
        EndIf
    Next
End Sub

Dim as string Arr(0),Txt="A Test Of String Split"
Dim as integer I

Split Txt,Arr()

?:?Txt:?
For I=0 To UBound(Arr)
    ?!"\t";I;"=";Arr(I)
Next
?:?:?"Press Any Key.....":sleep

[fxm]

Not so easy!
You're very very lucky that it works, because when compiling with option -exx, the program crashes!!!

When you declare the string array:
Dim as string Arr(0)
the array is declared as static array, and you cannot resize static array but only dynamic array (otherwise memory pollution by fixed array size overflow).
As the resizing is inside a procedure, the compiler does not output an error!

Corrected program:

Code: Select all

Sub Split(iTxt as string,iArr() as string,iDelim as string=" ")
    Dim as integer I,X
    For I=0 To Len(iTxt)-1
        If Chr(iTxt[I])=iDelim Then
            X+=1
            ReDim Preserve iArr(X)
        Else
            iArr(X)&=Chr(iTxt[I])
        EndIf
    Next
End Sub

ReDim as string Arr(0)
Dim as string Txt="A Test Of String Split"
Dim as integer I

Split Txt,Arr()

?:?Txt:?
For I=0 To UBound(Arr)
    ?!"\t";I;"=";Arr(I)
Next
?:?:?"Press Any Key.....":sleep

Try your version ('Dim as string Arr(0)') with a big string (many words to induce many array elements):
Dim as string Txt="A Test Of String Split, A Test Of String Split, A Test Of String Split, A Test Of String Split, A Test Of String Split"
and you will see the crash (even without option -exx).
It is the increase of the descriptors array which pollutes the memory and not the strings character data which are always dynamically allocated.

[dodicat]

Also, you must allow for a string which perhaps has no spaces at all.
Anyway, there are billions of ways to split strings.
Here's another, with option to get rid of a character altogether, and skipping arrays.

Code: Select all

function replace(in as string,oldchar as string,newchar as string,byref n as integer=0) as string
    var oldasci=asc(oldchar),newasci=asc(newchar),copy=in:n=0
    #macro purge()
    For i As integer =0 To Len(in)-1 
    If in[i]<>oldasci Then copy=copy+Chr(in[i])else n=n+1
    Next i
#endmacro
if newasci=0 then
    copy="":purge()
    return copy
end if
    for z as integer=0 to len(copy)-1
        if copy[z]=oldasci then copy[z]=newasci:n=n+1
    next z
    function=copy
end function

dim as string s="Yet another example:,,, a test of replace, now, getting rid of commas."

print s
print 
dim as string answer
dim as integer number
answer=replace(s,",",chr(0),number) 'get rid of comma
print answer
print
print number & " commas"
print
answer=replace(answer," ",chr(10),number)'newline at space

print answer
print
print number & " blanks"


print "________  f (f(string)) __________________"
'or perhaps
dim as string remove=chr(0),blank=" ",newline=chr(10)
print replace(replace(s,",",remove),blank,newline)

sleep

 

[xroot]

fxm

Thanks, for the heads up on the Redim, learn somthing everyday.
again thanks.