Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [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

@Theta: The GOTO-Hunter strikes again..

Uploader:Redakteurytwinky
Datum/Zeit:11.04.2012 21:21:26

'http://www.freebasic-portal.de/code-beispiele/string-funktionen/eine-schnelle-stringreplace-funktion-246.html
'@Theta: Meine Version ist nicht immer schneller als deine, aber sie funktioniert ohne GOTO *rofl*
'leider landet mein Version mit FB-Standard-Funktionen unter 'ferner liefen' ;-(((
'Autor:Theta
#Include "vbCompat.Bi"
Function StringReplace(text As String, expression As String, replacedBy As String, start As UInteger=1) As String
  Dim As Integer i=start-1, l_expr=Len(expression), l_repl=Len(replacedBy)
  Dim As String new_text
  If l_expr > Len(text) Or l_expr=0 Or start > Len(text) Then Return text
  new_text=text
  Do
    For j As Integer=0 To l_expr-1 'jeden Buchstaben von expression mit dem Entsprechenden von new_text vergleichen
      If new_text[i+j]<>expression[j] Then Goto Nothing_Found
    Next
    'hier kommen wir nur hin, wenn alle Buchstaben der beiden Teile übereinstimmen
    new_text=Mid(new_text,1,i) + replacedBy + Mid(new_text,1+i+l_expr)
    i += l_repl-1  'einen folgenden Teil müssen wir uns nicht anschauen, den kennen wir ja (replacedBy)
    '--------------------------------------------------
    Nothing_Found: 'ein Buchstabenpaar war nicht gleich
    i+=1
  Loop Until i=Len(new_text)
    Return new_text
End Function

'Autor:ytwinky
Function yStringReplace(text As String, expression As String, replacedBy As String, start As UInteger=1) As String 'OHNE GOTO ;-))
  Var i=start-2, l_expr=Len(expression), l_repl=Len(replacedBy), j=0, new_text=Text
  If l_expr>Len(text) Or l_expr=0 Or start>Len(text) Then Return text
  Do
    i+=1
    For j=0 To l_expr-1 'jeden Buchstaben von expression mit dem Entsprechenden von new_text vergleichen
      If expression[j]<>new_text[i+j] Then Continue Do
    Next
    'hier kommen wir hin, wenn alle Buchstaben der beiden Teile übereinstimmen
    new_text=Left(new_text, i) & replacedBy & Mid(new_text, i+1+l_expr) ' ich benutze lieber & zum Verketten von Strings..
    i +=l_repl-1
  Loop Until i>=Len(new_text)
    Return new_text
End Function

Function Replace(Text As String, Suche As String, ErsetzeMit As String) As String
  Var s=Text, i=Instr(s, Suche)
  While i
    s=Left(s, i-1) &ErsetzeMit &Mid(s, i+Len(Suche))
    i=Instr(i+Len(Suche)+1, s, Suche)
  Wend
  Return s
End Function

Dim As String dest, src="Dies ist ein besonders langer Text! Nein, es ist mein Beispiel", expr="ein", repl="kein"
Dim As Double t
t=Timer
For i As Integer=1 To 100000 'Hunderttausend Mal
  dest=StringReplace(src,expr,repl)
Next
t=Timer-t
Print "Bei StringReplace dauert's " & Format(t, "0.#00s") &".."
Print Src &!"\n" &dest
t=Timer
For i As Integer=1 To 100000 'Hunderttausend Mal
  dest=yStringReplace(src,expr,repl)
Next
t=Timer-t
Print "Bei yStringReplace dauert's " & Format(t, "0.#00s") &".."
Print Src &!"\n" &dest
t=Timer
For i As Integer=1 To 100000 'Hunderttausend Mal
  dest=Replace(src,expr,repl)
Next
t=Timer-t
Print "Bei Replace dauert's " & Format(t, "0.#00s") &".."
Print Src &!"\n" &dest &!"\nEniki..";
GetKey