Eine wichtige Operation der Datenverarbeitung ist die Text-Ersetzung, welche in einer Zeichenkette (Text) alle Vorkommen eines bestimmten Strings (sOld) durch einen anderen String (sNew) ersetzt. Optional kann die Anzahl der Ersetzungen (Count), der gewünschte Vergleichsmodus (Compare, s.a. VB-Hilfe zur InStr-Funktion) sowie die Start-Position (führt in VB6 zu fehlerhaften Ergebnissen) angegeben werden. Man beachte, dass diese Funktion deutlich schneller als die seit VB6 eingebaute Funktion ist, da keine Zeichenketten-Operationen verwendet werden, sondern ausschließlich das wenig bekannte Mid$-Statement. Ausserdem wird die Compare-Option vbTextCompare besonders effizient umgesetzt. Die hier gezeigte Routine ist 100%ig Aufruf-kompatibel zu der in VB6 (bis natürlich auf den unsinnigen Start-Parameter-Bug in VB6). Public Function Replace(ByRef Text As String, _ ByRef sOld As String, ByRef sNew As String, _ Optional ByVal Start As Long = 1, _ Optional ByVal Count As Long = 2147483647, _ Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _ ) As String ' (c) Jost Schwider, VB-Tec.de If LenB(sOld) Then If Compare = vbBinaryCompare Then ReplaceBin Replace, Text, Text, _ sOld, sNew, Start, Count Else ReplaceBin Replace, Text, LCase$(Text), _ LCase$(sOld), sNew, Start, Count End If Else ' Suchstring ist leer: Replace = Text End If End Function Die oben gezeigte Funktion übernimmt die Verwaltung der Parameter und ggf. der Umsetzung der Groß-/Kleinschreibung. Die eigentliche Arbeit findet in folgender Prozedur statt: Private Static Sub ReplaceBin(ByRef Result As String, _ ByRef Text As String, ByRef Search As String, _ ByRef sOld As String, ByRef sNew As String, _ ByVal Start As Long, ByVal Count As Long _ ) ' (c) Jost Schwider, VB-Tec.de Dim TextLen As Long Dim OldLen As Long Dim NewLen As Long Dim ReadPos As Long Dim WritePos As Long Dim CopyLen As Long Dim Buffer As String Dim BufferLen As Long Dim BufferPosNew As Long Dim BufferPosNext As Long ' Ersten Treffer bestimmen: If Start < 2 Then Start = InStrB(Search, sOld) Else Start = InStrB(Start + Start - 1, Search, sOld) End If If Start Then OldLen = LenB(sOld) NewLen = LenB(sNew) Select Case NewLen Case OldLen ' einfaches Überschreiben: Result = Text For Count = 1 To Count ' String "patchen": MidB$(Result, Start) = sNew ' Position aktualisieren: Start = InStrB(Start + OldLen, Search, sOld) If Start = 0 Then Exit Sub Next Count Exit Sub Case Is < OldLen ' Ergebnis wird kürzer: ' Buffer initialisieren: TextLen = LenB(Text) If TextLen > BufferLen Then Buffer = Text BufferLen = TextLen End If ' Ersetzen: ReadPos = 1 WritePos = 1 For Count = 1 To Count ' String "patchen": CopyLen = Start - ReadPos BufferPosNew = WritePos + CopyLen MidB$(Buffer, WritePos) = MidB$(Text, ReadPos _ , CopyLen) MidB$(Buffer, BufferPosNew) = sNew ' Positionen aktualisieren: WritePos = BufferPosNew + NewLen ReadPos = Start + OldLen Start = InStrB(ReadPos, Search, sOld) If Start = 0 Then Exit For Next Count ' Ergebnis zusammenbauen: If ReadPos > TextLen Then Result = LeftB$(Buffer, WritePos - 1) Else MidB$(Buffer, WritePos) = MidB$(Text, ReadPos) Result = LeftB$(Buffer, WritePos + _ LenB(Text) - ReadPos) End If Exit Sub Case Else ' Ergebnis wird länger: ' Buffer initialisieren: TextLen = LenB(Text) BufferPosNew = TextLen + NewLen If BufferPosNew > BufferLen Then Buffer = Space$(BufferPosNew) BufferLen = LenB(Buffer) End If ' Ersetzung: ReadPos = 1 WritePos = 1 For Count = 1 To Count ' Positionen berechnen: CopyLen = Start - ReadPos BufferPosNew = WritePos + CopyLen BufferPosNext = BufferPosNew + NewLen ' Ggf. Buffer vergrößern: If BufferPosNext > BufferLen Then Buffer = Buffer & Space$(BufferPosNext) BufferLen = LenB(Buffer) End If ' String "patchen": MidB$(Buffer, WritePos) = MidB$(Text _ , ReadPos, CopyLen) MidB$(Buffer, BufferPosNew) = sNew ' Positionen aktualisieren: WritePos = BufferPosNext ReadPos = Start + OldLen Start = InStrB(ReadPos, Search, sOld) If Start = 0 Then Exit For Next Count ' Ergebnis zusammenbauen: If ReadPos > TextLen Then Result = LeftB$(Buffer, WritePos - 1) Else BufferPosNext = WritePos + TextLen - ReadPos If BufferPosNext < BufferLen Then MidB$(Buffer, WritePos) = MidB$(Text _ , ReadPos) Result = LeftB$(Buffer, BufferPosNext) Else Result = LeftB$(Buffer, WritePos - 1) & _ MidB$(Text, ReadPos) End If End If Exit Sub End Select Else ' Kein Treffer: Result = Text End If End Sub Dieser Tipp wurde bereits 42.677 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |