<%
' ----------------------------------------------------------------------------
' Zoom Search Engine 2.0 (18/8/2003)
' Standard version for ASP
' A fast custom website search engine
' Copyright (C) Wrensoft 2000 - 2003
'
' email: zoom@wrensoft.com
' www: http://www.wrensoft.com
' ----------------------------------------------------------------------------
' ----------------------------------------------------------------------------
' Settings (change if necessary)
' ----------------------------------------------------------------------------
' Highlight matched words in results
Highlighting = 0 ' 0 = off, 1 = on
HighlightColor = "#FFFF40" ' Highlight colour
' Set this to your template HTML page
' (for the formatting and location of the search form)
TemplateFilename = "search_template.html"
' The options available in the dropdown menu for number of results
' per page
PerPageOptions = Array(10, 20, 50, 100)
FormFormat = 2 '0 = No search form (note that you must pass parameters to
' the script directly from elsewhere on your website).
'1 = Basic search form
'2 = Advanced search form (with options)
ZoomInfo = 1 '0 = Don't display Zoom info line at bottom of search
'1 = Display Zoom info line at bottom of search
OutputStyle = 1 '0 = Basic Style, Page Title, Score and URL
'1 = Descriptive Stlye, Match number, Page Title,
' Page description, Score and URL
Logging = 0 '0 = No logging of words that a user enter.
'1 = Words are logged to a file for later analysis. (See
' documentation for file permission issues)
LogFileName = ".\logs\searchwords.log" 'Path and File name of search word log file
MaxKeyWordLineLen = 2000 'Maximum line length of a single line in the KeyWords file.
'Increase, if required, so that
'MaxKeyWordLineLen >= Number of web pages in site * 6
WordSplit = 1 '0 = Only split input search phrase into words when a
' Space character is found
'1 = Split input search phrase at Space ' ',
' UnderScore '_' , Dash '-' and Plus '+' characters
Timing = 0 '0 = don't display timing results of search
'1 = display timing results
' ----------------------------------------------------------------------------
' Parameter initilisation
' ----------------------------------------------------------------------------
' for compatibility with Zoom < 2.0 HTML forms
' using the POST 'searchword' parameter
if Request.Form("searchword").Count = 1 then
query = Request.Form("searchword")
end if
' we use the method=GET and 'query' parameter now (for sub-result pages etc)
if Request.QueryString("zoom_query").Count <> 0 then
query = Request.QueryString("zoom_query")
end if
' number of results per page, defaults to 10 if not specified
if Request.QueryString("zoom_per_page").Count <> 0 then
per_page = Request.QueryString("zoom_per_page")
else
per_page = 10
end if
' current result page number, defaults to the first page if not specified
if Request.QueryString("zoom_page").Count <> 0 then
page = Request.QueryString("zoom_page")
else
page = 1
end if
' AND operator.
' 1 if we are searching for ALL terms
' 0 if we are searching for ANY terms (default)
if Request.QueryString("zoom_and").Count <> 0 then
andq = Request.QueryString("zoom_and")
else
andq = 0
end if
selfURL = Request.ServerVariables("URL")
if (Highlighting = 1) then
dim matchwords()
matchwords_num = 0
ReDim matchwords(0) ' ensures that it is an array for LBound to work
end if
Sub PrintEndOfTemplate
'Let others know about Zoom.
if (ZoomInfo = 1) then
Response.Write("Search powered by Zoom Search Engine
") & VbCrlf
end if
if (UBound(Template) > 0) then
'If rest of template exists
Response.Write(Template(1)) & VbCrLf
end if
End Sub
' Translate a wildcard pattern to a regexp pattern
' Supports '*' and '.' only at the moment.
Function pattern2regexp(pattern)
' ASP/VBScript's RegExp has some 7-bit ASCII char issues
' and treats accented characters as an end of word for boundaries ("\b")
' So we use ^ and $ instead, since we're matching single words anyway
pattern2regexp = "^"
pattern = Replace(pattern, "*", ".*")
pattern = Replace(pattern, "?", ".")
pattern2regexp = pattern2regexp & pattern
pattern2regexp = pattern2regexp + "$"
End Function
'Returns true if a value is found within the array
Function IsInArray(strValue, arrayName)
Dim iLoop, bolFound
IsInArray = False
if (IsArray(arrayName) = False) then
Exit Function
End if
For iLoop = LBound(arrayName) to UBound(arrayName)
if (CStr(arrayName(iLoop)) = CStr(strvalue)) then
IsInArray = True
Exit Function
end if
Next
End Function
Function PrintHighlightDescription(line)
For i = 0 to UBound(matchwords)
'replace with marker text, '[;:]' and '[:;]'
regExp.Pattern = "\b(" & matchwords(i) & ")\b"
line = regExp.Replace(line, "[;:]$1[:;]")
Next
line = replace(line, "[;:]", "")
line = replace(line, "[:;]", "")
Response.Write(line)
End Function
Function SplitMulti(string, delimiters)
For i = 1 to UBound(delimiters)
string = Replace(string, delimiters(i), delimiters(0))
Next
string = Trim(string) 'for replaced quotes
SplitMulti = Split(string, delimiters(0))
End Function
' ----------------------------------------------------------------------------
' Main starts here
' ----------------------------------------------------------------------------
' For timing of the search
if (Timing = 1) then
Dim StartTime, ElapsedTime
StartTime = Timer
end if
'Open and print start of result page template
set fso = CreateObject("Scripting.FileSystemObject")
set template = fso.OpenTextFile(Server.MapPath(TemplateFilename), 1)
' find the "" string in the template html file
dim line, templateFile
do while template.AtEndOfStream <> True
line = template.ReadLine & VbCrLf
templateFile = templateFile & line
loop
Template = split(templateFile, "")
Response.Write(Template(0)) & VbCrLf
' Replace the key text with the following
if (FormFormat > 0) then
' Insert the form
Response.Write("") & VbCrlf
end if
' Give up early if no search words provided
if Len(query) = 0 then
'Response.Write("No search query entered.
")
'stop here, but finish off the html
call PrintEndOfTemplate
Response.End
end if
'Split search phrase into words
query = Trim(query) 'for wildcards
if WordSplit = 1 then
SearchWords = SplitMulti(query, Array(" ", "-", "_", "[", "]", "+", """", "'"))
else
SearchWords = Split(query)
end if
' Load the entire pages file into an array, all URL's on the site
set pages_file = fso.OpenTextFile(Server.MapPath("zoom_pages.dat"), 1)
urls = split(pages_file.ReadAll, chr(13) & chr(10))
' Load the entire page titles file into an array
set titles_file = fso.OpenTextFile(Server.MapPath("zoom_titles.dat"), 1)
titles = split(titles_file.ReadAll, chr(13) & chr(10))
if OutputStyle = 1 then
set desc_file = fso.OpenTextFile(Server.MapPath("zoom_descriptions.dat"), 1, False)
descriptions = split(desc_file.ReadAll, chr(13) & chr(10))
end if
'Print heading
Response.Write("Search results for: """ & query & """
") & VbCrlf
'Open keywords file
set fpkeywords = fso.OpenTextFile(Server.MapPath("zoom_keywords.dat"), 1, False)
'Loop through all search words
numwords = UBound(SearchWords)+1
outputline = 0
dim output()
'default to use wildcards
UseWildCards = 1
'Initialise regular expression object
set regExp = New RegExp
regExp.IgnoreCase = True
regExp.Global = True
for sw = 0 to numwords-1
' check whether there are any wildcards used
if (InStr(SearchWords(sw), "*") = False AND InStr(SearchWords(sw), "?") = False) then
UseWildCards = 0
else
' new keword pattern to match for
regExp.Pattern = pattern2regexp(SearchWords(sw))
UseWildCards = 1
end if
'Read in a line at a time from the keywords file
do while fpkeywords.AtEndOfStream <> True
line = fpkeywords.ReadLine
data = Split(line, ",")
if (UseWildCards = 0) then
bMatched = Lcase(SearchWords(sw)) = Lcase(data(0))
else
bMatched = regExp.Test(data(0))
end if
if (bMatched = True) then
'Keyword found, so include it in the output list
if (Highlighting = 1) then
' Add to matched words list
if (IsInArray(data(0), matchwords) = False) then
Redim preserve matchwords(matchwords_num)
matchwords(matchwords_num) = data(0)
matchwords_num = matchwords_num + 1
end if
end if
num = UBound(data)
for kw = 1 to num Step 2
'Check if page is already in output list
pageexists = 0
ipage = data(kw)
for ol = 0 to outputline-1
if output(0, ol) = ipage then
'Page is already in output list, so add to count + extra
if (output(1, ol) > 10000) then
' take it easy if its too big
output(1, ol) = output(1, ol) + 1
else
output(1, ol) = Int(output(1, ol)) + Int(data(kw+1)) 'Add in score
output(1, ol) = output(1, ol) * 2 'Double score as we have two words matching
end if
output(2, ol) = Int(output(2, ol)) + 1 'Increase word match count
pageexists = 1
end if
next
if pageexists = 0 then
'New page to add to list
redim preserve output(3, outputline)
output(0, outputline) = ipage 'Page index
output(1, outputline) = Int(data((kw+1))) 'Score
output(2, outputline) = 1 'Single word match only
outputline = outputline + 1
end if
next
if (UseWildCards = False) then
exit do
end if
end if
loop
'Return to start of file - apparently only way to do this in ASP
'is close and re-open (according to msdn technet)
fpkeywords.Close
set fpkeywords = fso.OpenTextFile(Server.MapPath("zoom_keywords.dat"), 1, False)
next
'Close the files used
fpkeywords.Close
pages_file.Close
titles_file.Close
if OutputStyle = 1 then
desc_file.Close
end if
'Get number of pages matched
matches = outputline
'Count number of output lines that match ALL search terms
'and also remove results filtered by AND operation
oline = 0
fullmatches = 0
do while ((oline < matches) AND numwords > 1)
if output(2, oline) = numwords then
fullmatches = fullmatches + 1
oline = oline + 1
elseif andq = 1 then
'AND search
'Remove the results filtered by AND
'by overwriting the last element, and then redim'ing
lastelem = UBound(output, 2)
output(0, oline) = output(0, lastelem)
output(1, oline) = output(1, lastelem)
output(2, oline) = output(2, lastelem)
redim preserve output(3, lastelem - 1)
matches = matches - 1
'note: we don't increment oline because we have to check lastelem
else
oline = oline + 1
end if
loop
if (andq = 1 AND numwords > 1) then
matches = fullmatches
end if
' Bubble sort the results
if (matches > 0) then
for i = UBound(output, 2)-1 To 0 Step -1
for j = 0 to i
if output(1, j) < output(1, j+1) then
'Swap the two array elements
temp = output(1, j+1)
output(1, j+1) = output(1, j)
output(1, j) = temp
temp = output(2, j+1)
output(2, j+1) = output(2, j)
output(2, j) = temp
temp = output(0, j+1)
output(0, j+1) = output(0, j)
output(0, j) = temp
end if
next
next
end if
'Display search results
Response.Write("")
if matches = 1 Then
Response.Write("1 result found.")
elseif matches = 0 Then
Response.Write("No results found.")
elseif numwords > 1 AND andq = 0 then
SomeTermMatches = matches - fullmatches
Response.Write("" & fullmatches & " results found containing all search terms. ")
if (SomeTermMatches > 0) then
Response.Write(SomeTermMatches & " results found containing some search terms.")
end if
Response.Write("")
elseif numwords > 1 AND andq = 1 then
Response.Write("" & fullmatches & " results found containing all search terms.")
else
Response.Write("" & matches & " results found.")
end if
Response.Write("
") & VbCrlf
'Number of pages of results
' Amazingly, there is no Ceiling function in VB prior to .NET
' Also note the way CInt rounds to nearest _whole_ number (0.5 -> 0, 1.5 -> 2)
' Hence this workaround
if (matches MOD per_page = 0) then
'whole number
num_pages = CInt(matches / per_page)
else
'unwholey number
num_pages = CInt((matches / per_page) + 0.5)
end if
'num_pages = Math.Ceiling(cDbl(matches / per_page)) ' cInt rounds the number up
if (num_pages > 1) then
Response.Write("
" & num_pages & " pages of results.
") & VbCrlf
end if
' Determine current line of result from the $output array
if (page = 1) then
arrayline = 0
else
arrayline = (page - 1) * per_page
end if
' The last result to show on this page
result_limit = arrayline + per_page
' Display the results
do while (arrayline < matches AND arrayline < result_limit)
ipage = output(0, arrayline)
score = output(1, arrayline)
if (OutputStyle = 0) then
'Basic style
Response.Write("" & "Page: " & titles(ipage) & "
") & VbCrlf
Response.Write("Score: " & score & " URL:" & urls(ipage) & "
") & VbCrlf
else
'Descriptive style
Response.Write("" & (arrayline+1) & ". " & titles(ipage) & "
") & VbCrlf
if (Highlighting = 1) then
PrintHighlightDescription(descriptions(ipage))
else
Response.Write(descriptions(ipage))
end if
Response.Write("...
") & VbCrlf
Response.Write("Terms matched: " & output(2, arrayline) & " Score: " & score & " URL: " & urls(ipage) & "
") & VbCrlf
end if
arrayline = arrayline + 1
loop
'Show links to other result pages
if (num_pages > 1) then
Response.Write("Result Pages: ")
if (page > 1) then
Response.Write("<< Previous ")
end if
for i = 1 to num_pages
if (CInt(i) = CInt(page)) then
Response.Write(page & " ")
else
Response.Write("" & i & " ")
end if
next
if (cInt(page) <> cInt(num_pages)) then
Response.Write("Next >> ")
end if
end if
' Time the searching
if (Timing = 1) then
ElapsedTime = Timer - StartTime
Response.Write("
Search took " & ElapsedTime & " seconds")
end if
'Print out the end of the template
call PrintEndOfTemplate
'Log the search words, if required
if (Logging = 1) then
LogString = FormatDateTime(Now) & ", " & Request.ServerVariables("REMOTE_ADDR") & ", """ & query & """, Matches = " & matches
set logfile = fso.OpenTextFile(Server.MapPath(LogFileName), 8, true, 0)
logfile.WriteLine(LogString)
logfile.Close
end if
%>