سهول بالبحث للارقام و الكلمات في ملفات القراءة

code:

Private Const ForReading = 1 'FileSystemObject constants

Private Const ForWriting = 2

Private Const ForAppending = 8

Public FileList As New Collection 'List of files to search

Public Results As New Collection 'Results filenames

Public pos As New Collection 'Results position in file

Public Sub AddFile(path As String, filename As String)

'Add files to list. wildcards allowed

Dim s As String

s = Dir(path + filename)

Do While s <> ""

FileList.Add path + s, path + s

s = Dir

Loop

End Sub

Public Sub ClearFileList()

'Clear the files list

Dim i As Integer

For i = 1 To FileList.Count

FileList.Remove 1

Next i

End Sub

Public Function Find(st As String) As Integer

'Find st in the files listed. returns the number of results

Dim tx As String, i As Integer

Find = 0

Set fso = CreateObject("Scripting.FileSystemObject")

For i = 1 To Results.Count

Results.Remove 1

Next i

For Each fn In FileList

Set fil = fso.GetFile(fn)

Set ts = fil.OpenAsTextStream(ForReading)

tx = ts.ReadAll

i = InStr(1, tx, st)

Do While i > 0

Find = Find + 1

Results.Add fn

pos.Add i

i = InStr(i + 1, tx, st)

Loop

ts.Close

Next fn

End Function

Public Function Lines(Result As Integer, nLines As Integer) As String

'Returns the lines surrounding the result (nLines above and under)

Dim l As Integer, i As Integer

Set fso = CreateObject("Scripting.FileSystemObject")

Set fil = fso.GetFile(Results(Result))

Set ts = fil.OpenAsTextStream(ForReading)

ts.Skip (pos(Result))

l = ts.Line

If l <= nLines Then

l = nLines + 1

End If

ts.Close

Set ts = fil.OpenAsTextStream(ForReading)

For i = 1 To l - nLines - 1

ts.SkipLine

Next i

For i = 1 To nLines * 2 + 1

Lines = Lines + ts.readline + vbCrLf

Next i

ts.Close

End Function