Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Split text to array very fast

Uploader:Mitgliedmarpon
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