'
' OneFile Search Engine (Ofsearch v1.0)
' Copyright sixto Luis Santos <sixtos@prtc.net>
' All Rights Reserved
'
' Note:
' This is freeware. This isn't in the public Domain.
' You can freely the your own site.
'
' You cannot re-distribute the code, by any means,
' Without the express written authorization by the author.
'
' Use this program at your own risk.
'
Dim matched
Dim Regex
Dim GetTitle
Dim FS
Dim Rflen
Dim RootFolder
Dim Doccount
Dim Docmatchcount
Dim Matchedcount
' ----------------------------------------------
' Procedure:searchfiles ()
' ----------------------------------------------
Public Sub searchfiles (FolderPath)
Dim Fsfolder
Dim FsFolder2
Dim Fsfile
Dim Fstext
Dim Filetext
Dim Filetitle
Dim Filetitlematch
Dim MatchCount
Dim Outputline
' Get the Starting folder
Set Fsfolder = fs. GetFolder (FolderPath)
' Iterate thru every file in the folder
For each fsfile in Fsfolder.files
' Compare the current file extension with the list of valid target files
If InStr (1, Validfiles, right (Fsfile.name, 3), vbTextCompare) > 0 Then
Doccount = Doccount + 1
' Open ' file to read its content
Set Fstext = Fsfile.openastextstream
Filetext = Fstext.readall
' Apply ' the regex search and get the count of matches found
MatchCount = Regex.execute (Filetext). Count
Matchedcount = Matchedcount + matchcount
If matchcount > 0 Then
Docmatchcount = Docmatchcount + 1
' Apply another regex to get ' the HTML document ' s title
Set Filetitlematch = Gettitle.execute (Filetext)
If filetitlematch.count > 0 Then
' Strip the title tags
Filetitle = Trim (replace (filetitlematch.item (0), 8), "</title>", "", 1,1,1))
' In-case ', the title is empty
If filetitle = "" Then
Filetitle = "No Title" ("& Fsfile.name &") "
End If
Else
' Create an alternate entry name (if no title found)
Filetitle = "No Title" ("& Fsfile.name &") "
End If
' Create the entry line with proper formatting
' Add the entry number
Outputline = "<b>" & Docmatchcount & ".</b>"
' Add the document name and link
Outputline = outputline & "<a href=" & Chr (+) & rootfld & Replace (Mid Fsfile.path,
Rflen), "\", "/" & Chr & "><B>"
Outputline = outputline & filetitle & "</B></a>"
' Add The Document information
Outputline = outputline & "<font size=1><br> Criteria matched" & MatchCount
& "Times-size:"
Outputline = outputline & FormatNumber (fsfile.size/1024,2, -1,0,-1) & "K bytes"
Outputline = Outputline & "-Last Modified:" & FormatDateTime
(fsfile.datelastmodified,vbshortdate) & "</Font><br>"
' Display entry
Response.Write Outputline
Response.Flush
End If
Fstext.close
End If
Next
' Iterate thru each subfolder and recursively call this procedure
For each fsFolder2 in Fsfolder.subfolders
Searchfiles Fsfolder2.path
Next
Set Filetitlematch = Nothing
Set Fstext = Nothing
Set Fsfile = Nothing
Set FsFolder2 = Nothing
Set Fsfolder = Nothing
End Sub
' ----------------------------------------------
' Procedure:search ()
' ----------------------------------------------
Sub Search (
The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion;
products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the
content of the page makes you feel confusing, please write us an email, we will handle the problem
within 5 days after receiving your email.
If you find any instances of plagiarism from the community, please send an email to:
info-contact@alibabacloud.com
and provide relevant evidence. A staff member will contact you within 5 working days.