VB 5/6-Tipp 0324: Große Textdateien schnell durchsuchen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text1"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Sub Command1_Click()
    Dim x As Long, Zeilen() As String, FName As String
    
    MousePointer = vbHourglass
    FName = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "TestFile.txt"
    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
                Call MsgBox("ListBox kann nicht mehr Einträge fassen!")
                Exit For
            End If
        Next x
        
        List1.Visible = True
    Else
        MsgBox ("Suchbegriff nicht vorhanden!")
    End If
    
    Label2.Caption = UBound(Zeilen) & " Zeile(n) gefunden"
    MousePointer = vbDefault
End Sub

Private Function FindTerm(File As String, s As String, ZZ() As String, _
    tl As String, tr As String) As Boolean
    
    Dim c As Long, i As Long, j As Long
    Dim FLen As Long, lc As Long, p As Long
    Dim v As Long, w As Long
    Dim f As Integer
    Dim a As String, d As String
    Dim buffer As String, old As String
    
  
    '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 As Long = 1024&
    
    ReDim ZZ(0)
    
    'Prüfen ob Parameter plausibel sind
    If Len(tl) = 0 Or Len(tr) = 0 Or Len(s) = 0 Or _
        Dir$(File, vbNormal) = "" Then
        
        Call MsgBox("Paramter stimmen nicht!")
        Exit Function
    End If
    
    f = FreeFile
    Open File For Binary Shared As #f
    FLen = LOF(f)
    
    'Anzahl der Durchläufe anhand der Dateigröße ermitteln
    p = FLen \ PS
    If FLen Mod PS <> 0 Then p = p + 1

    'Schleife starten
    For c = 1 To p
        buffer = Space$(PS)
        Get f, , buffer
        a = old & buffer
        
        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)
                      
                        'gefunden
                        If InStr(1, tl, d) Then
                            v = j + 1
                            Exit For
                        End If
                    Next j
            
                    'Zeilenende suchen
                    w = 0
                    For j = i To Len(a)
                        d = Mid$(a, j, 1)
                        
                        'gefunden
                        If InStr(1, tr, d) Then
                            w = j
                            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)
                        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
                old = a
            Else
                'Ab Ende der zuletzt gefundenen Zeile des aktuel-
                'len Paketes für die nächste Runde speichern
                old = Mid$(a, lc)
            End If
        Else
            'Paket der aktuellen Runde speichern
            old = buffer
        End If
    Next c
    Close f
    
    If UBound(ZZ) > 0 Then FindTerm = True
End Function

Private Sub List1_Click()

End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von Gerhard am 09.07.2007 um 13:26

Guten Tag Ihr guten Helferlein,

dieser Tip ist wie geschaffen für mich.
Ich muß aus einer großen Datei nach bestimmten Zeichenketten suchen eine Zeile von ca. 200 000 Zeilen
sieht so aus:
$000278+0000+001181392789 +1 +000000+01.06.2007+00:10:12
Die Pluszeichen sind Trennzeichen.
Bisher habe ich die Datei geöffnet und mit Split den String
zerlegt. Dann konnte ich sagen welchen Teilstring ich mit dem Suchstring verleichen wollte. Diese Suche dauerte unter
Umständen Minuten.
Frage hat jemand eine Idee wie ich diesen Tipp auf mein Problem zuschneiden kann.

Kommentar von Perry am 13.03.2006 um 08:49

Meine kleine Funktion ist sicher nicht perfekt, regt aber vll. zum Verbessern an! =?)




Public Function Searching(Suchbegriff As String, Path As String) As integer
Dim Zeile As String
Dim gefunden As Boolean
dim fso, objFile, objFolder

Set fso = CreateObject("Scripting.FileSystemObject")
Searching = 0

Set objFolder = fso.GetFolder(Path)

For Each objFile In objFolder.Files
Open objFile For Input As #1
Do While Not EOF(1)
Line Input #1, Zeile
If InStr(1, Zeile, Suchbegriff, vbBinaryCompare) Then gefunden = True: Exit Do
Loop
If gefunden = True Then
Searching = Searching + 1
gefunden = False
End If
Close #1
Next objFile
End Function

Kommentar von Markus B. am 29.05.2004 um 09:13

HI Fabian!

Sorry,aber ich weiß nicht was es daran auszusetzen gibt!!!
Meiner Meinung nach ist der Quellcode genügend auskommentiert,und es ist ja nicht sooo ein komplizierter
Allgorithmus, daß man jede Zeile kommentieren muß.

Kommentar von Fabian am 11.05.2004 um 14:05

Jeder der so für seinen Chef programmiert kriegt früher oder später eine aufs Dach.
Aber immerhin ein paar kleine Kommentare drin....

Kommentar von Gr.C.S. Software am 30.03.2004 um 09:31

'Netter Tipp, aber leider viel zu langsam !

'Wenn man so codiert wie hier beschrieben, hat man einen lahmen Rechner. Ausserdem gibt es einen viel einfacheren weg !!!!!!
'erstens !
'hier wird Zeichenweise umgewandelt das kann man aber
'auch mit mehreren lol !
'Der User wird es euch danken !!!!!
'
'Hier mein Code
Dim DataSpeicher As String, DataI As String, Suche As String
Dim Zähler As Integer, Datei$, SuchErfolg As Integer

' Setzen der Vars Suchbegriff und Datei
Suche = "EFLGS=00010246"
Datei$ = "C:\Windows\Faultlog.txt"

Open Datei$ For Input As #1
'Wird in schleife abgefragt mit line wirde eine ganze line
'getastet bis der CRLF kommt !
SuchErfolg = 0
Do
'bei Ende schleife verlassen
If EOF(1) = True Then Exit Do
'einlesen
Line Input #1, DataI
'lange Kette Bilden
DataSpeicher = DataSpeicher + DataI
'Bei gefunden Festhalten in Var und "Do" verlassen.
If InStr(DataSpeicher, Suche) > 0 Then
SuchErfolg = 1
Exit Do
End If
Zähler = Zähler + 1
If Zähler = 5 Then
Zähler = 0
If Len(DataSpeicher) = 5 Then
'kürzen auf 14 zeichen
DataSpeicher = Right$(DataSpeicher, 14)
End If
End If
Loop
Close #1
If SuchErfolg = 1 Then MsgBox "Gefunden !!!"
If SuchErfolg = 0 Then MsgBox "Nicht DA :-("
End Sub

Kommentar von Gr.C.S. Software am 30.03.2004 um 09:30

'Netter Tipp, aber leider viel zu langsam !

'Wenn man so codiert wie hier beschrieben, hat man einen lahmen Rechner. Ausserdem gibt es einen viel einfacheren weg !!!!!!
'erstens !
'hier wird Zeichenweise umgewandelt das kann man aber
'auch mit mehreren lol !
'Der User wird es euch danken !!!!!
'
'Hier mein Code
Dim DataSpeicher As String, DataI As String, Suche As String
Dim Zähler As Integer, Datei$, SuchErfolg As Integer

' Setzen der Vars Suchbegriff und Datei
Suche = "EFLGS=00010246"
Datei$ = "C:\Windows\Faultlog.txt"

Open Datei$ For Input As #1
'Wird in schleife abgefragt mit line wirde eine ganze line
'getastet bis der CRLF kommt !
SuchErfolg = 0
Do
'bei Ende schleife verlassen
If EOF(1) = True Then Exit Do
'einlesen
Line Input #1, DataI
'lange Kette Bilden
DataSpeicher = DataSpeicher + DataI
'Bei gefunden Festhalten in Var und "Do" verlassen.
If InStr(DataSpeicher, Suche) > 0 Then
SuchErfolg = 1
Exit Do
End If
Zähler = Zähler + 1
If Zähler = 5 Then
Zähler = 0
If Len(DataSpeicher) = 5 Then
'kürzen auf 14 zeichen
DataSpeicher = Right$(DataSpeicher, 14)
End If
End If
Loop
Close #1
If SuchErfolg = 1 Then MsgBox "Gefunden !!!"
If SuchErfolg = 0 Then MsgBox "Nicht DA :-("
End Sub

Kommentar von Rick am 23.05.2003 um 14:46

Strukturiert ist der Tip ja, aber damit hat sichs. Die einfachsten Regeln der Programmierung wurden nicht eingehalten. Es ist nicht zu erkennen, welche Variable was beinhaltet. Auch der Gültigkeitsbereich lässt sich nicht von den Variablenbezeichnungen, wenn man das so nennen kann, ableiten. Wenn so in einem großen Projekt codiert werden würde, dann haben die nachfolgenden Programmierer viel Freude beim Einarbeiten. Aufwand Einarbeitung mehrfach größer als Aufwand für Fehlerbeseitigung, Suche und/oder Erweiterung.

Kommentar von Meister Phantom am 21.01.2003 um 12:08

irgendwie kapier ich diesen tipp nicht!

ich habe eine txt file die sich wie folgt zusammen setzt:
"Wert1","Wert2","Wert3","Wert4","Wert5","Wert6","Wert7","Wert8","Wert9","Wert10","Wert11","Wert12","Wert13","Wert14","Wert15","Wert16"

so dann kann es passieren das die datei größer als 10 MB wird.
blos leider frisst meine suchrutiene viel zu lange 100 % systemleistung und brauch für ca 10000 daten sätze 1 min!
jetz wollte ich diesen Tipp nehmen aber ich kapier ihn nicht btw habe keine ahnung wie ich den auf meine txt file anpasse.
kann mir jmd von euch helfen?

Kommentar von Frank Maier am 31.12.2002 um 20:12

Bis ich diesen Tip endlich für mich leserlich gemacht habe, das hat vielleicht lang gebraucht.

Kommentar von Hendrik Jordt am 12.12.2002 um 11:37

Mmmhhh....

dieser Tipp zeigt unter VB6 u. NT4.0 keine Wirkung. Egal ob man auf Großschreibung achtet oder nicht, der Suchtext wird nicht gefunden!

Kommentar von Atze Dillinger am 04.06.2002 um 15:06

Also wenn ich so unübersichtliche Programme schreiben würde, würde ich von meinem Chef ärger bekommen!