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: 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 30.286 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |