VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Historie
16.12.2000	Im "Nahbereich" wird nun konventionell (d.h. linear) gesucht, was nochmal etwa 30% bringt; außerdem funktioniert die Routine jetzt auch für sehr große Strings
15.12.2000	Die Nutzung von InStrB beschleunigt die Suche nochmal um etwa 30%
07.11.2000	Kleinere Änderungen bringen nochmal gut 2% für API-Version
30.10.2000	Alternative API-Version verdoppelt u.U. die Performance
29.10.2000	Erste Version

VB5 bietet von Haus aus keine Rückwärts-Suche innerhalb von Strings an. Die folgende Routine implementiert daher die seit VB6 bekannte Funktion und ist (dank binärer Suche) oft sogar schneller:

Public Function InStrRev( _
    ByRef sCheck As String, _
    ByRef sMatch As String, _
    Optional ByVal Start As Long, _
    Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
  ) As Long
  
  Dim Stopp As Long
  Dim Index As Long
  Dim Pivot As Long
  Dim Length As Long
  Dim LengthPtr As Long
  Dim MatchLen As Long
  
  If Compare = vbBinaryCompare Then
    MatchLen = LenB(sMatch) - 1
    If MatchLen > -1 Then
    
      'Linke Grenze bestimmen:
      Stopp = InStrB(sCheck, sMatch)
      If Stopp = 0 Then Exit Function
      
      'Rechte Grenze bestimmen:
      Length = LenB(sCheck)
      If Start <= 0 Then
        Start = Length - MatchLen
        LengthPtr = StrPtr(sCheck) - 4
      Else
        Start = Start + Start - MatchLen
        If Stopp > Start Then Exit Function
        LengthPtr = StrPtr(sCheck) - 4
        PokeLng LengthPtr, Start + MatchLen
      End If
      
      'Ersten Treffer merken:
      InStrRev = Stopp
      Stopp = Stopp + 2
      
      'Binäre Suche / Intervall-Halbierungs-Verfahren:
      Do
        'Ab Mitte testen:
        Pivot = (Stopp + Start) \ 2
        Index = InStrB(Pivot, sCheck, sMatch)
        
        'Treffer?
        If Index Then
          InStrRev = Index
          If Index >= Start Then
            PokeLng LengthPtr, Length
            InStrRev = InStrRev \ 2 + 1
            Exit Function
          End If
          Stopp = Index + 2
        Else
          If Stopp + 8 >= Pivot Then Exit Do
          Start = Pivot - 1
          PokeLng LengthPtr, Start + MatchLen
        End If
      Loop
      
      'Konventionell weiter machen:
      Index = InStrB(Stopp, sCheck, sMatch)
      Do While Index
        InStrRev = Index
        Index = InStrB(Index + 2, sCheck, sMatch)
      Loop
      InStrRev = InStrRev \ 2 + 1
      PokeLng LengthPtr, Length
    
    Else
      If Start <= Len(sCheck) Then InStrRev = Start
    End If
  Else
    InStrRev = InStrRev(LCase$(sCheck), LCase$(sMatch), Start)
  End If
End Function

Bei grossen Zeichenketten könnte es passieren, dass der hintere Bereich mehrmals durchsucht werden müßte. Daher wird der String intern (durch temporäres Patchen der Längenangabe) gekürzt. So müssen bereits durchsuchte Bereiche nicht nochmal durchlaufen werden. Dies geschieht mit Hilfe folgender API-Deklaration:

'Deklarationsteil:
Private Declare Sub PokeLng Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Addr As Long, Value As Long, _
    Optional ByVal Bytes As Long = 4)