PureBoard

Code: Alles auswählen

Procedure.s StringFieldChain(String$, Index, Trennzeichen$,Modus=0)
  back$ = ""
  IndexX.l = 1
  zeichen.l = Len(Trennzeichen$) 
  If Modus = #PB_String_NoCase
    Trennzeichen$ = LCase(Trennzeichen$)
    TestString$ = LCase(String$)
  Else
    TestString$ = String$
  EndIf 
  If Index > 0
    For a.l = 1 To Len(String$)
      x1$ = Mid(String$,a,1)
      If Mid(TestString$,a,Len(Trennzeichen$)) = Trennzeichen$  
        If IndexX = Index
          Break
        EndIf
        IndexX.l = IndexX.l +1
        x1$ = ""        
        back$ = ""
        a = a + zeichen.l -1
      EndIf
      back$ = back$ + x1$
    Next a
    If IndexX < Index   
      back$ = ""
    EndIf
  EndIf
  ProcedureReturn back$
EndProcedure

Code: Alles auswählen

; Beispiel: 
Text$ = "Als Trennzeichen können hier auch zeichenketten angegeben werden."
Debug StringFieldChain(Text$, 1, "können")
Debug StringFieldChain(Text$, 2, "TrennZEICHEN ",#PB_String_NoCase)
Text$ = "abc#*#def#*#ghi#*#jkl#*#mno#*#pqr"
For k=1 To 6
  Debug "Teil " + Str(k) + "= "+ StringFieldChain(Text$, k, "#*#")
Next

Code: Alles auswählen

Procedure.s StringFieldChain(String$, Index, Trennzeichen$, Modus = 0)
  Protected zeichen, i, TestString$
  
  If Modus = #PB_String_NoCase
    Trennzeichen$ = LCase(Trennzeichen$)
    TestString$ = LCase(String$)
  Else
    TestString$ = String$
  EndIf 
  
  If Index > 0
    zeichen = Len(Trennzeichen$) 
    lastIndex = 1
    For i = 1 To Index
      nextIndex = FindString(TestString$, Trennzeichen$, lastIndex)
      If nextIndex = 0
        If i = Index
          ProcedureReturn Mid(String$, lastIndex)
        EndIf
        ProcedureReturn ""
      ElseIf i <> Index
        lastIndex = nextIndex + zeichen
      EndIf 
    Next
    ProcedureReturn Mid(String$, lastIndex, nextIndex - lastIndex)
  EndIf 
EndProcedure

; Beispiel:
Define Text$, i
Text$ = "Als Trennzeichen können hier auch zeichenketten angegeben werden."
Debug StringFieldChain(Text$, 1, "können")
Debug StringFieldChain(Text$, 2, "TrennZEICHEN ", #PB_String_NoCase)
Text$ = "abc#*#def#*#ghi#*#jkl#*#mno#*#pqr"
For i = 1 To 6
  Debug "Teil " + Str(i) + " = "+ StringFieldChain(Text$, i, "#*#")
Next

Code: Alles auswählen

EnableExplicit

Procedure.s StringFieldChain(String.s, Index.i, Separator.s, Mode.i = 0)

  Protected.i PosNew, PosOld, LenSeparator, IndexPos
  Protected.s TempString

  If Mode = #PB_String_NoCase
    TempString = LCase(String)
    Separator = LCase(Separator)
  Else
    TempString = String
  EndIf

  If Index < 1 Or Index > CountString(TempString, Separator) + 1
    ProcedureReturn ""
  EndIf

  LenSeparator = Len(Separator)
  PosOld = 1
  PosNew = FindString(TempString, Separator, 1)

  For IndexPos = 2 To Index
    PosOld = PosNew + LenSeparator
    PosNew = FindString(TempString, Separator, PosOld)
  Next

  If PosNew = 0
    ProcedureReturn Mid(String, PosOld)
  EndIf

  ProcedureReturn Mid(String, PosOld, PosNew - PosOld)

EndProcedure

; Beispiel:
Define Text.s, i.i

Text = "Als Trennzeichen können hier auch Zeichenketten angegeben werden."
Debug StringFieldChain(Text, 1, "können")
Debug StringFieldChain(Text, 2, "TrennZEICHEN ", #PB_String_NoCase)

Text = "abc#*#def#*#ghi#*#jkl#*#mno#*#pqr"
For i = 1 To 6
  Debug "Teil " + Str(i) + " = "+ StringFieldChain(Text, i, "#*#")
Next

Code: Alles auswählen

; Syntax
; Ergebnis$ = StringFieldChain(String$, Index, Trennzeichen$ [, Modus])
;
; Beschreibung
; Gibt den Feldinhalt des 'String$' an der angegebenen Stelle 'Index' zurück.
; Ein 'Trennzeichen$' (bestehend aus einem oder mehreren Zeichen) wird zur Aufteilung des Strings benutzt.
; Die erste 'Index'-Position ist 1.
; 'Modus' ist ein optionaler Parameter und kann folgenden Wert annehmen:
; #PB_String_NoCase : Suchen/Entfernen unabhängig von Groß-/Kleinschreibung 
Procedure.s StringFieldChain(String.s, Index.i, Trennzeichen.s, Modus.i = 0)
	Protected *start = @String, *t.Character = @Trennzeichen
	Protected *c.Character = *start + SizeOf(Character)
	Repeat
		If (*t\c = 0 Or *c\c = 0)
			If (Index = 1)
				ProcedureReturn PeekS(*start, *c - *start - (*t - @Trennzeichen))
			EndIf
			*start = *c
			Index - 1
		EndIf
		If (*c\c = 0)
			ProcedureReturn ""
		EndIf
		
		If (*c\c = *t\c)
			*t + SizeOf(Character)
		Else
			*t = @Trennzeichen
		EndIf
		
		*c + SizeOf(Character)
	ForEver
EndProcedure

For i = 1 To 4
	Debug "'" + StringFieldChain("Das ist ein Test ist ein Test ein Test", i, " ein ", 0) + "'"
Next

For i = 1 To 11
	Debug "'" + StringFieldChain("NicTheQuick", i, "", 0) + "'"
Next