AW: Find Funktion in Textdatei
15.12.2003 18:05:26
andre
hallo tobias,
habe im inet gestöbert und das gefunden:
' 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
'Autor: Dieter Otter Homepage: http://www.tools4vb.de/
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)
'von mir auskommentiert andre
' 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
Sub test()
Dim lngPos As Long
lngPos = SearchFileForText("c:\test.txt", "suchtext")
If lngPos > 0 Then
MsgBox "Gefunden an Position " & CStr(lngPos)
Else
MsgBox "Suchtext nicht gefunden!"
End If
End Sub