FreeBASIC 文字列操作 Split()

'Split  version 02
'by ptitjoz ≫ Apr 09, 2018 14:18
'https://www.freebasic.net/forum/viewtopic.php?p=245695#p245695

'==================================================
' Split02 Sub
'==================================================

Sub Split02(ByVal s As String,delimit As String,Outcome() As String)
   ReDim Outcome(0)

   Dim As String t=s     '作業文字列
   Dim As Integer nb=0   '要素の数
   Dim As Integer p,i

   ' 配列のサイズを決定する要素の数を見つける
   For i=1 To Len(s)
   	If Mid(s,i,1)=delimit Then nb=nb+1
   Next

   '配列のサイジング
   nb=nb+1 ' 最後の要素に 1 を加算
   ReDim Outcome(1 To nb) 
   
   '配列に記入
   For i=1 To nb
   	p=InStr(t,delimit)
   	Outcome(i)= Mid(t,1,p-1)
   	t=Right(t,Len(t)-p)
   Next

End Sub


'==================================================
' 活用例
'==================================================

Dim As String s = "aaaa	bbbbbb	ccccc	ddddddd	eeeeee"  '切り取る文字列
Dim As String deliminator
ReDim As String r()

deliminator ="	" '区切り文字 Tab の例
Print Asc(deliminator) 'Tab の文字コードは9
Print

Split02(s,deliminator,r())
For n As Long=LBound(r) To UBound(r)
   Print n,r(n),Len(r(n))
Next

Sleep

'Split_dodicat
'by dodicat ≫ Apr 09, 2018 15:14
'https://www.freebasic.net/forum/viewtopic.php?p=245701#p245701

'==================================================
' string_split Sub
'==================================================

Sub string_split(ByVal s As String,chars As String,result() As String)
   ReDim result(0)
   Dim As String var1,var2
   Dim As Long pst,LC=Len(chars)
   
   #Macro split(stri)
      pst=InStr(stri,chars)
      var1="":var2=""
      If pst<>0 Then
         var1=Mid(stri,1,pst-1)
         var2=Mid(stri,pst+LC)
      Else
         var1=stri
      End If
      
      If Len(var1) Then 
         ReDim Preserve result(1 To UBound(result)+1)
         result(UBound(result))=var1
      End If
   #EndMacro
   
   Do
      split(s):s=var2
   Loop Until var2=""
End Sub


'==================================================
' 活用例
'==================================================

Dim As String s="aaaa123456789bbbbbb123456789ccccc123456789ddddddd123456789eeeeee"
Dim As String deliminator
ReDim As String r()

deliminator="123456789"

string_split(s,deliminator,r())

For n As Long=LBound(r) To UBound(r)
   Print n,r(n)
Next

Sleep

'How do I Split a string on whitespace?
'by fxm ≫ Jul 20, 2025 13:52
'
'My own "Split_fxm()" version, longer but improved for execution time (for very large strings), and working for any separator size:
'
'https://www.freebasic.net/forum/viewtopic.php?p=308292#p308292

Sub Split_fxm(ByRef s1 As String, ByRef s2 As String, Splits(Any) As String, ByVal skipEmptyElement As Integer = 1)
    Dim As Any Ptr p1 = CPtr(Any Ptr Ptr, @S1)[0]
    Dim As Integer l1 = CPtr(Integer Ptr, @S1)[1]
    Dim As Integer l2 = CPtr(Integer Ptr, @s2)[1]
    If l2 = 0 Then l2 = 1
    Dim As Integer i = UBound(Splits) + 1
    Dim As Integer n, n0 = 1

    ReDim Preserve Splits(LBound(Splits) To i + l1 / l2)
    Do
        n = InStr(n0, s1, s2)
        If n > 0 Then
            If (skipEmptyElement = 0) OrElse (n - n0) > 0 Then
                CPtr(Any Ptr Ptr, @S1)[0] = p1 + n0 - 1
                CPtr(Integer Ptr, @S1)[1] = n - n0
                Splits(i) = s1
                CPtr(Any Ptr Ptr, @S1)[0] = p1
                CPtr(Integer Ptr, @S1)[1] = l1
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) OrElse (l1 - n0 + 1) > 0 Then
                CPtr(Any Ptr Ptr, @S1)[0] = p1 + n0 - 1
                CPtr(Integer Ptr, @S1)[1] = l1 - n0 + 1
                Splits(i) = s1
                CPtr(Any Ptr Ptr, @S1)[0] = p1
                CPtr(Integer Ptr, @S1)[1] = l1
            Else
                i -= 1
            End If
            If i >= LBound(Splits) Then
                ReDim Preserve Splits(LBound(Splits) To i)
            Else
                Erase Splits
            End If
            Exit Do
        End If
    Loop
End Sub

'==================================================
' 活用例
'==================================================

Dim As String Instring = "Hello How Are You Today"
Dim As String tokens()

Split_fxm(instring, " ", tokens())

For i As UInteger = LBound(tokens) To UBound(tokens)
   Print tokens(i)
Next i

Sleep
Print

Erase tokens

Instring = "    Hello How Are You Today   ."
Split_fxm(instring, " ", tokens())

For i As UInteger = LBound(tokens) To UBound(tokens)
   Print tokens(i)
Next i

Sleep
Print

Erase tokens

Instring = "aaaa123456789bbbbbb123456789ccccc123456789ddddddd123456789eeeeee"
Split_fxm(instring, "123456789", tokens())

For i As UInteger = LBound(tokens) To UBound(tokens)
   Print tokens(i)
Next i

Sleep
Print

'How do I split a string on whitespace?
'by dodicat ≫ Jul 21, 2025 22:14
'https://www.freebasic.net/forum/viewtopic.php?p=308340#p308340
'What about string that might start or end or both with the delimiter?


Function tally(somestring As String,partstring As String,arr() As Long) As ULong
    ReDim arr(1 To 1000)
    Dim As Long i,j,ln,lnp,count
    ln=Len(somestring)
    lnp=Len(partstring)
    count=0
    i=-1
    Do
        i+=1
        If somestring[i] <> partstring[0] Then Continue Do
        If somestring[i] = partstring[0] Then
            For j=0 To lnp-1
                If somestring[j+i]<>partstring[j] Then Continue Do
            Next j
        End If
        count+=1
        If count>UBound(arr) Then ReDim Preserve arr(LBound(arr) To count+count)
        arr(count)=i+1
        i=i+lnp-1
    Loop Until i>=ln-1
    ReDim Preserve arr(1 To count)
    Return count
End Function


Function SplitString(somestring As String,partstring As String,aa() As String) As Long
    ReDim As Long x()
    Var t= tally(somestring,partstring,x()),lps=Len(partstring)
    If t=0 Or Len(somestring)=0 Or lps=0 Then Return 0
    ReDim As String a(1 To t+1)
    ReDim aa(1 To t+1)
    a(1)=Mid(somestring,1,x(1)-1)
    For n As Long=1 To UBound(x)-1
        a(n+1)= Mid(somestring,x(n)+lps,x(n+1)-x(n)-lps)
    Next n
    Dim As Long count
    a(UBound(a))=Mid(somestring,x(UBound(x))+lps)
    For n As Long=LBound(a) To UBound(a)
        If a(n)<>"" Then  count+=1:aa(count)=a(n)
    Next
    ReDim Preserve aa(1 To count)
    Return count
End Function


'==================================================
' 活用例
'==================================================

Dim As String Instring = "    Hello How Are You Today   ."
Dim As String tokens()
Print SplitString(instring, " ", tokens());" elements"
For i As UInteger = LBound(tokens) To UBound(tokens)
   Print i,tokens(i)
Next i
Print

 #define range(f,l) Int(Rnd*((l+1)-(f))+(f))

Dim As String s=String(10000000,0) 
For n As Long=0 To Len(s)-1
    Var r=range(65,90)
    If Rnd>.5 Then r+=32
    s[n]=r
Next
Print "String made"
Dim As Long tk
Dim As Double t=Timer
Print SplitString(s,"aBcw",tokens());" elements";Timer-t;" seconds"
For n As Long=LBound(tokens) To UBound(tokens)
    tk+=Len(tokens(n))
    Print n,"element length ";Len(tokens(n))
Next

Print "String size = ";Len(s),"sum lengths of elements ";tk
Sleep

Print
Erase tokens

Instring = "aaaa123456789bbbbbb123456789ccccc123456789ddddddd123456789eeeeee"

Print SplitString(instring, "123456789", tokens());" elements"
For i As UInteger = LBound(tokens) To UBound(tokens)
   Print i,tokens(i)
Next i
Print
Sleep