vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Dateisystem · Dateien allgemein   |   VB-Versionen: VB4, VB5, VB619.12.01
Eine Datei beliebigen Typs schnell durchsuchen

Mit Hilfe der hier vorgestellten Funktion lässt sich eine Datei beliebigen Typs schnell nach einem Text durchsuchen.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  20.317 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8 Beispielprojekt auf CD 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    Diesmal möchten wir Ihnen eine Funktion vorstellen, mit der sich eine Datei beliebigen Typs (Textdatei, EXE, Word, usw). schnell nach einem bestimmten Text durchsuchen lässt.

    Schnell deshalb, da die Datei nicht zeilenweise (sowie nur bei Textdateien sinnvoll), sondern Blockweise eingelesen wird.

    Die Funktion SearchFileForText sollte durch die gute Kommentierung weitestgehend verständlich und leicht nachvollziehbar sein.

    ' Durchsucht eine Datei nach einem bestimmten Text
    ' und gibt die Position der Funstelle zurück,
    ' bzw. den Wert 0, wenn der Text nicht gefunden wurde
    Public Function SearchFileForText(ByVal sFile As String, _
      ByVal sText As String, _
      Optional ByVal lngStart As Long = 1) As Long
     
      Dim F As Integer
      Dim lngStrLen As Long
      Dim lngFound As Long
      Dim lngFileSize As Long
      Dim lngFilePos As Long
      Dim lngReadSize As Long
      Dim sTemp As String
      Dim sPrev As String
      Dim intProz As Integer
     
      ' Größe eines einzelnen einzulesenden Datenblocks
      Const lngBlockSize = 4096
     
      ' Länge des gesuchten Textes
      lngStrLen = Len(sText)
     
      ' Falls die Datei gar nicht existiert, oder der
      ' kein Suchtext angegeben wurde, wird die Funktion
      ' hier verlassen
      If Dir$(sFile) = "" Or lngStrLen = 0 Then Exit Function
     
      ' Datei im Binärmodus öffnen
      F = FreeFile
      Open sFile For Binary As #F
     
      ' Größe der Datei
      lngFileSize = LOF(F)
     
      ' Start-Position
      If lngStart > 1 Then
        Seek #F, lngStart
        lngFilePos = lngStart - 1
      End If
     
      ' Solange "blockweise" einlesen, bis entweder das
      ' Dateiende erreicht oder der Text gefunden wurde
      While lngFilePos < lngFileSize And lngFound = 0
     
        If lngFilePos + lngBlockSize > lngFileSize Then
          ' Falls aktuelle Position + Blockgröße über das
          ' Dateiende hinaus geht -> Blockgröße neu festlegen
          ' (maximal bis Dateiende)
          lngReadSize = lngFileSize - lngFilePos
        Else
          ' ansonsten: festgelegte Blockgröße einlesen
          lngReadSize = lngBlockSize
        End If
     
        ' Variable vorbereiten (mit Leerzeichen fülen)
        sTemp = Space$(lngReadSize)
     
        ' Datenblock einlesen (Größe = lngReadSize)
        Get #F, , sTemp
     
        ' die letzten Zeichen des vorigen Blocks nochmals
        ' mit in den Suchvorgang einbeziehen, denn es
        ' könnte ja sein, dass sich der gesuchte Text
        ' genau an zwischen dem letzten und dem aktuell
        ' eingelesenen Block befindet
        sTemp = sPrev + sTemp
     
        ' Ist der gesuchte Text enthalten?
        lngFound = InStr(sTemp, sText)
        If lngFound > 0 Then
          ' JA, Suchtext ist enthalten!
          ' Position ermitteln
          lngFound = lngFilePos + lngFound - lngStrLen
        End If
     
        ' aktuelle Position aktualisieren
        lngFilePos = lngFilePos + lngReadSize
     
        ' Fortschritt anzeigen
        intProz = Int(lngFilePos / lngFileSize * 100 + 0.5)
        lblStatus.Caption = "Suche läuft... " & CStr(intProz) & "%"
        DoEvents
     
        sPrev = Right$(sTemp, lngStrLen)
      Wend
     
      ' nachfolgender Code nur zu Testzwecken
      ' (einfach später dann auskommentieren)
      If lngFound > 0 Then
        sTemp = Space$(lngStrLen)
        Seek #F, lngFound
        Get #F, , sTemp
        Debug.Print sTemp
      End If
     
      ' Datei schliessen
      Close #F
     
      ' Funktionsrückgabewert: Fundstelle (Position)
      SearchFileForText = lngFound
    End Function

    Die Funktion selbst erwartet folgende Parameter:
    sFile: vollständiger Name der Datei
    sText: gesuchter Text
    lngStart: Start-Position für die Suche

    Beispielsaufruf

    Dim lngPos As Long
     
    lngPos = SearchFileForText("c:\test.dat", "Suchtext")
    If lngPos > 0 Then
      MsgBox "Gefunden an Position " & CStr(lngPos)
    Else
      MsgBox "Suchtext nicht gefunden!"
    End If

    Dieser Tipp wurde bereits 20.317 mal aufgerufen.

    Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

    Über diesen Tipp im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Neue Diskussion eröffnen

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!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.
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle 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.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel