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.428 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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats Juli 2024 Dieter Otter Beliebige Zeichen am Anfang und Ende eines Strings entfernen Mit der Trim-Funktion lassen sich nicht nur Leerzeichen, sondern bei Bedarf auch beliebige Zeichen entfernen. sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! |
||||||||||||||||
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. |