' benötigt werden: Textfeld Text1, Command-Button Command1, List-Box List1 und 
' Label Label2
Option Explicit
 
Private Sub Text1_Validate(KeepFocus As Boolean)
    If Len(Text1) = 1 Then
    MsgBox "Devi inserire piú di una lettera sola!!!", vbCritical
    End If
End Sub
 
Private Sub Text1_GotFocus()
 
' Markieren wenn Text1 wieder angeklickt wird
 
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
End Sub
 
Private Sub Command1_Click()
  Dim x&, Zeilen() As String, FName$
 
 
    MousePointer = vbHourglass
    FName = App.Path & "\wb2.dat"
    List1.Clear
    Label2.Caption = ""
    Label2.Refresh
 
    'Die letzten beiden Parameter geben das linke und rechte
    'Begrenzungszeichen einer Zeile an, dies können auch
    'mehrere sein. Hier wurde für links vbLf (chr$(10)) und
    'für rechts vbCr (chr$(13)) gewählt
    If FindTerm(FName, Text1.Text, Zeilen, vbLf, vbCr) Then
      List1.Visible = False
      DoEvents
      For x = 0 To UBound(Zeilen) - 1
        If x < 32736 Then
          List1.AddItem Zeilen(x)
        Else
          List1.Clear
          List1.AddItem "Non c'é posto per tutti i nomi!"
          List1.AddItem "Specifica la tua richiesta!"
          Exit For
        End If
      Next x
      List1.Visible = True
    Else
      List1.AddItem "Parola non trovata!"
    End If
    If UBound(Zeilen) = 1 Then
    Label2.Caption = "1 riga trovata"
    ElseIf UBound(Zeilen) = 0 Then
    Label2.Caption = "0 rige trovate"
    ElseIf UBound(Zeilen) > 1 Then
    Label2.Caption = UBound(Zeilen) & " rige trovate"
    Else
    Label2.Caption = UBound(Zeilen) & " Riga(e) trovata(e)"
    End If
    MousePointer = vbDefault
End Sub
 
Private Function FindTerm(File$, s$, ZZ$(), tl$, tr$) As Boolean
  Dim c&, f%, i&, j&, L&, lc&, p&, v&, w&
  Dim a$, d$, n$, o$
 
  'Dieser Wert gibt die Paketgröße von Get# an. Er kann beliebig
  'geändert werden, sollte aber nicht kleiner als die längste
  'zu erwartende Zeile des zu druchsuchenden Files sein
  Const PS& = 1024&
 
    ReDim ZZ(0)
 
    'Prüfen ob Parameter plausibel sind
    If tl$ = "" Or _
       tr$ = "" Or _
       s$ = "" Or _
       Dir$(File, vbNormal) = "" Then
 
      List1.AddItem "I Parametri non sono giusti!"
      Exit Function
    End If
 
    f = FreeFile
    Open File For Binary Shared As #f
      L = LOF(f)
 
      'Anzahl der Durchläufe anhand der Dateigröße ermitteln
      p = L \ PS
      If L Mod PS <> 0 Then p = p + 1
 
      'Schleife starten
      For c = 1 To p
        n = Space$(PS)
        Get f, , n
        a = o & n
        i = InStr(1, a, s)
        If i <> 0 Then
          'Suchbegriff wurde im aktuellen Paket gefunden
          lc = 0
          Do
            i = InStr(i, a, s)
            If i <> 0 Then
 
              'Zeilenanfang suchen
              v = 1
              For j = i To 1 Step -1
                d = Mid$(a, j, 1)
                If InStr(1, tl, d) Then
                  'gefunden
                  v = j + 1
                  Exit For
                End If
              Next j
 
              'Zeilenende suchen
              w = 0
              For j = i To Len(a)
                d = Mid$(a, j, 1)
                If InStr(1, tr, d) Then
                  'gefunden
                  w = j - 1
                  Exit For
                End If
              Next j
 
              If w <> 0 Then
                'Zeile auschneiden und in einem Feld speichern
                'Hier könnten auch weitere Suchkriterien abge-
                'fragt werden.
                ZZ(UBound(ZZ)) = Mid$(a, v, w - v + 1)
                ReDim Preserve ZZ(0 To UBound(ZZ) + 1)
                lc = w
              End If
 
              i = w
            End If
          'Weiter schleifen, da der Suchbegriff im Paket ja
          'öfters als einmal auftauchen kann
          Loop Until i = 0
 
          If lc = 0 Then
            'Suchbegriff wurde im aktuellen Paket nicht ge-
            'funden. Daher ganzen String für die nächste Runde
            'speichern
            o = a
          Else
            'Ab Ende der zuletzt gefundenen Zeile des aktuel-
            'len Paketes für die nächste Runde speichern
            o = Mid$(a, lc)
          End If
        Else
          'Paket der aktuellen Runde speichern
          o = n
        End If
      Next c
    Close f
 
    If UBound(ZZ) > 0 Then FindTerm = True
End Function

|||10110100011111110011|||