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 |