Make a personal search engine (source code)

Source: Internet
Author: User
Tags add chr count end
Search Engine <%
Response.buffer=true

'
' 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.
'


' Globals--------------------------------------
' ----------------------------------------------

Const validfiles = "Htmltxt"
Const rootfld = "./"

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 (



Contact Us

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.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.