vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
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:  Views:  30.214 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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



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.
 
 
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.