Search Our Website
<%
response.write "" & vbCrLf
response.write "" & vbCrLf
response.write " " & vbCrLf
'Code stripper- have search page search READABLE TEXT ONLY- no results from code!
Function clean(codedPage) ' Removes all HTML and other code from a given input.
Set RegularExpressionObject = New RegExp
With RegularExpressionObject
.Pattern = "<[^>]+>" 'HTML Stripper code
.IgnoreCase = True
.Global = True
End With
clean = RegularExpressionObject.Replace(codedPage, "")
Set RegularExpressionObject = nothing
End Function
'For testing of the code stripper only:
'codedPage = "Hello World"
'cleanedPage = clean(codedPage)
'response.write cleanedPage & "
"
Dim searchTerm
searchTerm = Replace(request.form("searchTerm"), "|", "|")
if len(searchTerm) < 3 then
searchTerm = ""
end if
if searchTerm <> "" then
response.write "You searched for "" & searchTerm & "" "
'Exclude pages: Open exclude file and read in page name values to an array:
whichFN=server.mappath("search-exclude.txt")
redim excludeArray(0)
redim searchArray(0)
redim resultArray(0)
s = 0
i = 0
r = 0
Dim fs
Set fs = server.CreateObject("Scripting.FileSystemObject")
If fs.FileExists(whichFN) Then
Set thisFile = fs.OpenTextFile(whichFN, 1, False)
do while not thisfile.AtEndOfStream
thisline = thisfile.readline
excludeArray(i) = thisline
redim preserve excludeArray(Ubound(excludeArray) + 1)
i = i + 1
loop
end if
'List all files in the current directory (also add to list all files in the catalog- IF in separate dir.)
strMsg = ""
mypath="./"
Set filesystem = CreateObject("Scripting.FileSystemObject")
Set folder = filesystem.GetFolder(server.mappath(mypath))
Set filecollection = folder.Files
For Each file in filecollection
'Look for searchable files by checking exclude list...
searchFlag = 1
if right(file.name,3) = "asp" then
for i = 0 to Ubound(excludeArray)
if file.name = excludeArray(i) then
searchFlag = 0
end if
next
if searchFlag = 1 then
'Open the file, read-all, clean, search:
whichfile=server.mappath(file.name)
Set fs = CreateObject("Scripting.FileSystemObject")
Set thisfile = fs.OpenTextFile(whichfile, 1, False)
tempSTR=thisfile.readall
searchPage = clean(tempSTR)
Dim oRegExp, colMatches, oMatch
Set oRegExp = New RegExp
oRegExp.Global = True
oRegExp.IgnoreCase = True
oRegExp.Pattern = searchTerm
Set colMatches = oRegExp.Execute(searchPage)
if colMatches.Count > 0 then
'Get page title from filename. Use document "search-pagenames.txt"
pageFN=server.mappath("search-pagenames.txt")
Dim fs2
Set fs2 = server.CreateObject("Scripting.FileSystemObject")
If fs2.FileExists(pageFN) Then
Set thisFile2 = fs2.OpenTextFile(pageFN, 1, False)
do while not thisfile2.AtEndOfStream
thisline = thisfile2.readline
intEndOfIndex = Instr(thisline, "|")
thisPage = mid(thisline, 1, intEndOfIndex - 1)
restOfLine = mid(thisline, intEndOfIndex + 1, len(thisline))
if thisPage = file.name then
pageTitle = restOfLine
exit do
end if
loop
end if
'Turn this into an array of results, ##|strMsg, then sort by ##, highest to lowest
linkname = file.name
if linkname = "inc-form-c.asp" then
linkname = "contact.asp"
end if
strMsg = "" & pageTitle & "
" & linkname & " - Matches: " & colMatches.Count & " " & vbCrLf
if len(colMatches.Count) < 2 then
matchCount = "0" & colMatches.Count
else
matchCount = colMatches.Count
end if
resultArray(r) = matchCount & "|" & strMsg
redim preserve resultArray(Ubound(resultArray) + 1)
r = r + 1
end if
searchFlag = 0
thisfile.Close
set thisfile=nothing
set fs=nothing
end if
end if
Next
set filesystem=nothing
set folder=nothing
set filecollection=nothing
'Time to sort resultArray with a simple BubbleSort:
for i = 0 to ubound(resultArray)
for j = i + 1 to ubound(resultArray)
intEndOfIndexi = Instr(resultArray(i), "|")
intEndOfIndexj = Instr(resultArray(j), "|")
indexi = left(resultArray(i), 2)
indexj = left(resultArray(j), 2)
if indexi > indexj then
arrTemp = resultArray(i) ' swap function: z=x
resultArray(i) = resultArray(j) ' x=y
resultArray(j) = arrTemp ' y=z Voila!
end if
next
next
response.write "| " & vbCrLf
if strMsg <> "" then
for i = Ubound(resultArray) to 0 step -1
intEndOfIndex = Instr(resultArray(i), "|")
resultArray(i) = mid(resultArray(i), intEndOfIndex + 1, len(resultArray(i)))
response.write resultArray(i) & vbCrLf
next
'if strMsg <> "" then
' response.write strMsg
else
response.write " Search term(s) not found, please reformulate your search and try again. "
end if
response.write " |
" & vbCrLf
end if
%>
|
