Zeichenfolge zwischen 2 Zeichen suchen Ermitteln einer Zeichenfolge zwischen 2 Zeichen.
Autor:   Richard Mittelstädt	Bewertung:	Views:  16.075
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	kein Beispielprojekt

Nachfolgende Funktion gibt die Zeichenfolge innerhalb eines Strings zurück, die sich zwischen zwei bestimmten Zeichen befindet. Kriterium ist ein Such-String, in dem Platzhalter erlaubt sind (zB. in .asp nach URL-Adresse suchen).

Public Function SucheStringZwischenZeichen(sText, sString, _
  Optional ZchLINKS As String = """", Optional ZchRECHTS = """", _
  Optional lIndex = 1, _
  Optional Von_RECHTS = False)
 
  ' ******************************************************************************
  ' sText      zu durchsuchender Text
  ' sString    zu suchender String:
  '            PLATZHALTER sind (like-Syntax, zB. "*/lpt*[0-9].zip") erlaubt !!!!!
  ' ZchLINKS   Linkes  Begrenzungs-Zeichen Optional, Standard: "
  '    Ist normalerweise gleich:
  ' ZchRECHTS  Rechtes Begrenzungs-Zeichen Optional, Standard: "
  ' lIndex     Das lIndex-te Vorkommen suchen Standard: 1     (erstes Vorkommen)
  ' Von_RECHTS Suchrichtung (True=Von Rechts) Standard: False (= Von Links suchen)
  '
  ' Man kann zB. eine .ASP-Datei einlesen, in sText übergeben und dann
  ' nach aktuellen (dyn.)URL-Angaben zwischen zwei "- Zeichen suchen lassen.
  '
  ' Wenn sString zwischen den beiden Zeichen entsprechend gefunden wird,
  ' dann wird der gesamte Text zwischen den beiden Zeichen zurückgegeben.
  ' Es wird das lIndex-te Vorkommen (von links bzw. rechts) ausgegeben.
  ' Wird das lIndex-te Vorkommen nicht gefunden, ist die Rückgabe "" .
  ' ******************************************************************************
 
  Dim Pos1 As Long        ' Pos. linkes  Zeichen
  Dim Pos3 As Long        ' Pos. rechtes Zeichen
  Dim n As Long           ' Zähler aktuell n-tes Vorkommen
  Dim sTemp As String     ' zu untersuchender Text
 
  On Error GoTo ERR_01
  SucheStringZwischenZeichen = ""
  sTemp = sText
  If Not sTemp Like "*" & ZchLINKS & sString & ZchRECHTS & "*" Then
    Exit Function
  End If
 
  n = 0
  If Von_RECHTS = False Then
    ' *************************** Suche von LINKS ***********************************
    Pos1 = 0                ' Am Anfang anfangen
SEARCH_NEXT_L:              ' Nächstes Vorkommen suchen
    Pos1 = Pos1 + 1
    If Not Mid(sTemp, Pos1) Like "*" & ZchLINKS & sString & ZchRECHTS & "*" Then
      Exit Function   ' kommt RECHTS nicht mehr vor
    Else
      ' --- Muss mind. noch einmal RECHTS vorkommen -----
      Pos1 = InStr(Pos1, sTemp, ZchLINKS)
      Pos3 = InStr(Pos1 + 1, sTemp, ZchRECHTS)
      If Mid(sTemp, Pos1, Pos3 - Pos1 + 1) Like _
        ZchLINKS & sString & ZchRECHTS Then
        n = n + 1           ' Gefunden zum n-ten mal.
      End If
      If n < lIndex Then
        GoTo SEARCH_NEXT_L  ' Nächstes Vorkommen suchen
      End If
    End If
  Else
    ' *************************** Suche von RECHTS **********************************
    Pos3 = Len(sTemp) + 1       ' Am Ende anfangen
SEARCH_NEXT_R:                  ' Nächstes Vorkommen suchen
    Pos3 = Pos3 - 1
    If Not Mid(sTemp, 1, Pos3) Like "*" & ZchLINKS & sString & ZchRECHTS & "*" Then
      Exit Function   ' kommt LINKS nicht mehr vor
    Else
      ' --- Muss mind. noch einmal LINKS vorkommen ------
      Pos3 = InStrRev(sTemp, ZchRECHTS, Pos3)
      Pos1 = InStrRev(sTemp, ZchLINKS, Pos3 - 1)
      If Mid(sTemp, Pos1, Pos3 - Pos1 + 1) Like _
        ZchLINKS & sString & ZchRECHTS Then
        n = n + 1               ' Gefunden zum n-ten mal.
      End If
      If n < lIndex Then
          GoTo SEARCH_NEXT_R      ' Nächstes Vorkommen suchen
      End If
    End If
  End If
  If n = lIndex Then
    SucheStringZwischenZeichen = Mid(sTemp, Pos1 + 1, Pos3 - Pos1 - 1)
  End If
 
  Exit Function
 
ERR_01:
  MsgBox "SucheStringZwischenZeichen(...): " & Err.Number & vbNewLine & Err.Description
End Function

Private Function testsuchstrpl0897()
  Dim t1
  t1 = "asdfspäter_" & Chr(34) & "-blablee.exe7" & _
    Chr(34) & "_bbb" & Chr(34) & "-blablee.exe8" & Chr(34)
  MsgBox SucheStringZwischenZeichen(t1, "*.exe*", , , 2, False)
 
  ' t1 = "asdfspäter_<-blablee.exe7>_bbbhhhhhhh_____<1234?.exe88>ghjkl"
  ' MsgBox SucheStringZwischenZeichen(t1, "*.exe*", "<", ">", 1, True)
 
  ' t1 = "asdfasdf_<http://www.trendmicro.com/ftp/products/" & _
  ' pattern/lpt989.zip>_blaaaaaaaaaaaaaa"
  ' MsgBox SucheStringZwischenZeichen(t1, "*/lpt*[0-9].zip", "<", ">", 1, True)
End Function

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

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.