% ' ---------------------------------------------------------------------------- ' Zoom Search Engine 4.2 (1/2/2006) ' Standard version for ASP ' A fast custom website search engine ' Copyright (C) Wrensoft 2000 - 2005 ' ' email: zoom@wrensoft.com ' www: http://www.wrensoft.com ' ---------------------------------------------------------------------------- Dim UseUTF8, Charset, MapAccents, MinWordLen, Highlighting, GotoHighlight, TemplateFilename, FormFormat, Logging, LogFileName Dim MaxKeyWordLineLen, MaxDictIDLen, NumKeywords, NumPages, DictReservedLimit, DictReservedPrefixes, DictReservedSuffixes, DictReservedNoSpaces Dim WordSplit, ZoomInfo, Timing, DefaultToAnd, SearchAsSubstring, ToLowerSearchWords, ContextSize, MaxContextKeywords, AllowExactPhrase Dim MaxContextSeeks, UseLinkTarget, LinkTarget, UseDateTime, WordJoinChars, Spelling, SpellingWhenLessThan, NumSpellings, UseCats, LinkBackURL Dim DisplayNumber, DisplayTitle, DisplayMetaDesc, DisplayContext, DisplayTerms, DisplayScore, DisplayURL, DisplayDate, Version Dim STR_FORM_SEARCHFOR, STR_FORM_SUBMIT_BUTTON, STR_FORM_RESULTS_PER_PAGE, STR_FORM_CATEGORY, STR_FORM_CATEGORY_ALL, STR_FORM_MATCH Dim STR_FORM_ANY_SEARCH_WORDS, STR_FORM_ALL_SEARCH_WORDS, STR_NO_QUERY, STR_RESULTS_FOR, STR_RESULTS_IN_ALL_CATEGORIES, STR_RESULTS_IN_CATEGORY Dim STR_POWEREDBY, STR_NO_RESULTS, STR_RESULT, STR_RESULTS, STR_PHRASE_CONTAINS_COMMON_WORDS, STR_SKIPPED_FOLLOWING_WORDS Dim STR_SKIPPED_PHRASE, STR_SUMMARY_NO_RESULTS_FOUND, STR_SUMMARY_FOUND_CONTAINING_ALL_TERMS, STR_SUMMARY_FOUND_CONTAINING_SOME_TERMS Dim STR_SUMMARY_FOUND, STR_PAGES_OF_RESULTS, STR_POSSIBLY_GET_MORE_RESULTS, STR_ANY_OF_TERMS, STR_ALL_CATS, STR_DIDYOUMEAN, STR_SORTEDBY_RELEVANCE Dim STR_SORTBY_RELEVANCE, STR_SORTBY_DATE, STR_SORTEDBY_DATE, STR_RESULT_TERMS_MATCHED, STR_RESULT_SCORE, STR_RESULT_URL, STR_RESULT_PAGES Dim STR_RESULT_PAGES_PREVIOUS, STR_RESULT_PAGES_NEXT, STR_SEARCH_TOOK, STR_SECONDS Dim zoomit, zoomfso, PerPageOptions Dim zoomquery, per_page, NewSearch, zoompage, andq, zoomcat, zoomsort, selfURL, zoomtarget Dim UseWildCards, SkippedOutputStr, SkippedWords, SkippedExactPhrase Dim catnames, catpages, catindex %>
<%
if (ScriptEngine <> "VBScript" OR ScriptEngineMajorVersion < 5) then
Response.Write("This script requires VBScript 5.5 or later installed on the web server. Please download the latest Windows Script package from Microsoft and install this on your server, or consult your web host ") Response.End end if if (ScriptEngineMajorVersion = 5 AND ScriptEngineMinorVersion < 5 AND AllowExactPhrase = 1) then Response.Write("This script requires VBScript 5.5 or later installed on the web server. Please download the latest Windows Script package from Microsoft and install this on your server, or consult your web host ") Response.Write("Note that you may be able to run this on VBScript 5.1 if you have Exact Phrase matching disabled. ") Response.End end if Function MapPath(path) Dim IsHSP on error resume next IsHSP = Server.IsHSPFile if (err.Number = 0 AND IsHSP) then MapPath = Server.MapExternalPath(path) ' for HSP support else MapPath = Server.MapPath(path) end if on error goto 0 End Function ' Check for dependant files set zoomfso = CreateObject("Scripting.FileSystemObject") if (zoomfso.FileExists(MapPath("settings.asp")) = False OR zoomfso.FileExists(MapPath("zoom_wordmap.zdat")) = FALSE OR zoomfso.FileExists(MapPath("zoom_dictionary.zdat")) = FALSE OR zoomfso.FileExists(MapPath("zoom_pages.zdat")) = FALSE OR zoomfso.FileExists(MapPath("zoom_titles.zdat")) = FALSE) then Response.Write("Zoom files missing error: Zoom is missing one or more of the required index data files. Please make sure the generated index files are uploaded to the same path as this search script. ") Response.End end if ' ---------------------------------------------------------------------------- ' Settings ' ---------------------------------------------------------------------------- ' The options available in the dropdown menu for number of results ' per page PerPageOptions = Array(10, 20, 50, 100) ' ---------------------------------------------------------------------------- ' Parameter initialisation ' ---------------------------------------------------------------------------- if (Len(Charset) > 0) then Response.Charset = Charset end if ' we use the method=GET and 'zoomquery' parameter now (for sub-result pages etc) if Request.QueryString("zoom_query").Count <> 0 then zoomquery = 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 NewSearch = 0 if Request.QueryString("zoom_page").Count <> 0 then zoompage = Request.QueryString("zoom_page") else zoompage = 1 NewSearch = 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") elseif (IsEmpty(DefaultToAnd) = false AND DefaultToAnd = 1) then andq = 1 else andq = 0 end if ' categories if Request.QueryString("zoom_cat").Count <> 0 then zoomcat = Int(Request.QueryString("zoom_cat")) else zoomcat = -1 end if ' for sorting options ' zero is default (relevance) ' 1 is sort by date (if date/time data is available) if Request.QueryString("zoom_sort").Count <> 0 then zoomsort = Int(Request.QueryString("zoom_sort")) else zoomsort = 0 end if if (IsEmpty(LinkBackURL)) then selfURL = Request.ServerVariables("URL") else selfURL = LinkBackURL end if zoomtarget = "" if (UseLinkTarget = 1) then zoomtarget = " target=""" & LinkTarget & """ " end if Sub PrintEndOfTemplate 'Let others know about Zoom. if (ZoomInfo = 1) then Response.Write(" " & STR_POWEREDBY & " Zoom Search Engine ") end if 'stop here, but finish off the html 'call PrintEndOfTemplate 'Response.End no longer used to allow for search.asp to follow through the original file 'when it is used in in an #include NoSearch = 1 end if if (NoSearch = 0) then ' Load index data files (*.zdat) ---------------------------------------------- Dim urls, titles, descriptions, datefile, dates_count Dim dictfile, dict_count, dictline ' Load the entire pages file into an array, all URL's on the site urls = split(ReadDatFile(zoomfso, "zoom_pages.zdat"), chr(10)) ' Load the entire page titles file into an array titles = split(ReadDatFile(zoomfso, "zoom_titles.zdat"), chr(10)) if (DisplayMetaDesc = 1) then descriptions = split(ReadDatFile(zoomfso, "zoom_descriptions.zdat"), chr(10)) if (descriptions(0) = "This file blank due to indexing configuration.") then Response.Write("Zoom config error: The zoom_descriptions.zdat file is not properly created for the search settings specified. Please check that you have re-indexed your site with the search settings selected in the configuration window. ") Response.End end if end if if (UseDateTime = 1 OR DisplayDate = 1) then datefile = split(ReadDatFile(zoomfso, "zoom_datetime.zdat"), chr(10)) dates_count = UBound(datefile)-1 dim datetime() redim datetime(dates_count) for zoomit = 0 to dates_count datetime(zoomit) = CDate(datefile(zoomit)) next end if if (DisplayContext = 1 OR AllowExactPhrase = 1) then Dim bin_pagetext, tmpstr set bin_pagetext = CreateObject("ADODB.Stream") bin_pagetext.Type = 1 ' stream type = binary bin_pagetext.Open ' open stream bin_pagetext.LoadFromFile MapPath("zoom_pagetext.zdat") 'load file to stream 'check for blank message tmpstr = CStr(bin_pagetext.Read(8)) if (tmpstr = "This") then Response.Write("Zoom config error: The zoom_pagetext.zdat file is not properly created for the search settings specified. Please check that you have re-indexed your site with the search settings selected in the configuration window. ") Response.End end if end if ' load in dictionary file dictfile = split(ReadDatFile(zoomfso, "zoom_dictionary.zdat"), chr(10)) dict_count = UBound(dictfile) dim dict() redim dict(2, dict_count) for zoomit = 0 to dict_count dictline = Split(dictfile(zoomit), " ") if (UBound(dictline) = 1) then dict(0, zoomit) = dictline(0) dict(1, zoomit) = dictline(1) end if next ' re-value dict_count in case of errors in dict file dict_count = UBound(dict, 2) ' load in wordmap file Dim bfp_wordmap set bfp_wordmap = CreateObject("ADODB.Stream") bfp_wordmap.Type = 1 'Specify stream type - we want To get binary data. bfp_wordmap.Open 'Open the stream bfp_wordmap.LoadFromFile MapPath("zoom_wordmap.zdat") 'Initialise regular expression object Dim regExp set regExp = New RegExp regExp.Global = True if (ToLowerSearchWords = 0) then regExp.IgnoreCase = False else regExp.IgnoreCase = True end if ' Prepare zoomquery for search ----------------------------------------------------- 'Split search phrase into words if (MapAccents = 1) then For zoomit = 0 to UBound(NormalChars) zoomquery = Replace(zoomquery, AccentChars(zoomit), NormalChars(zoomit)) Next end if if (AllowExactPhrase = 0) then zoomquery = Replace(zoomquery, """", " ") end if if (InStr(WordJoinChars, ".") = False) then zoomquery = Replace(zoomquery, ".", " ") end if if (InStr(WordJoinChars, "-") = False) then regExp.Pattern = "(\S)-" zoomquery = regExp.Replace(zoomquery, "$1 ") 'zoomquery = Replace(zoomquery, "-", " ") end if if (InStr(WordJoinChars, "_") = False) then zoomquery = Replace(zoomquery, "_", " ") end if if (InStr(WordJoinChars, "'") = False) then zoomquery = Replace(zoomquery, "'", " ") end if if (InStr(WordJoinChars, "#") = False) then zoomquery = Replace(zoomquery, "#", " ") end if if (InStr(WordJoinChars, "$") = False) then zoomquery = Replace(zoomquery, "$", " ") end if if (InStr(WordJoinChars, ",") = False) then zoomquery = Replace(zoomquery, ",", " ") end if if (InStr(WordJoinChars, ":") = False) then zoomquery = Replace(zoomquery, ":", " ") end if if (InStr(WordJoinChars, "&") = False) then zoomquery = Replace(zoomquery, "&", " ") end if ' Strip slashes, sloshes, parenthesis and other regexp elements ' also strip any of the wordjoinchars if followed immediately by a space regExp.Pattern = "[\/\s\\\\(\)\^\[\]\|\+\{\}]+|[\.\-\_\'\,]\s" zoomquery = regExp.Replace(zoomquery, " ") ' update the encoded/output zoomquery with our changes encQuery = Encode(zoomquery) ' Split exact phrase terms if found dim SearchWords, quote_terms, term, exclude_terms, tmp_query quote_terms = Array() exclude_terms = Array() tmp_query = zoomquery if (InStr(zoomquery, """")) then regExp.Pattern = """.*?""" set quote_terms = regExp.Execute(zoomquery) tmp_query = regExp.Replace(tmp_query, "") end if if (InStr(zoomquery, "-")) then regExp.Pattern = "(\s|^)-.*?(?=\s|$)" set exclude_terms = regExp.Execute(tmp_query) tmp_query = regExp.Replace(tmp_query, "") end if tmp_query = Trim(tmp_query) regExp.Pattern = "[\s\+]+" tmp_query = regExp.Replace(tmp_query, " ") SearchWords = Split(tmp_query, " ") 'SearchWords = SplitMulti(tmp_query, Array(" ", "_", "[", "]", "+", ",")) zoomit = UBound(SearchWords) for each term in quote_terms zoomit = zoomit + 1 redim preserve SearchWords(zoomit) SearchWords(zoomit) = Replace(term, """", "") next ' add exclusion search terms (make sure we put them last) zoomit = UBound(SearchWords) for each term in exclude_terms zoomit = zoomit + 1 redim preserve SearchWords(zoomit) SearchWords(zoomit) = Trim(term) next 'Print heading Response.Write(" " & STR_RESULTS_FOR & " " & encQuery)
if (UseCats = 1) then
if (zoomcat = -1) then
Response.Write(" " & STR_RESULTS_IN_ALL_CATEGORIES)
else
Response.Write(" " & STR_RESULTS_IN_CATEGORY & " """ & catnames(zoomcat) & """")
end if
end if
Response.Write(" ") & VbCrlf Response.Write(" ") & VbCrLf
' Begin main search loop ------------------------------------------------------
Dim numwords, outputline, pagesCount, matches, relative_pos, current_pos
Dim context_maxgoback
Dim exclude_count, ExcludeTerm
'Loop through all search words
numwords = UBound(SearchWords)+1
outputline = 0
'default to use wildcards
UseWildCards = 1
' Check for skipped words in search zoomquery
SkippedWords = 0
SkippedOutputStr = ""
SkippedExactPhrase = 0
pagesCount = UBound(urls)
Dim res_table()
Redim preserve res_table(5, pagesCount)
matches = 0
relative_pos = 0
current_pos = 0
dim data
dim phrase_data_count()
dim phrase_terms_data()
dim xdata()
dim countbytes
exclude_count = 0
context_maxgoback = 1
redim sw_results(numwords)
Dim sw, bSkipped, ExactPhrase, patternStr, WordNotFound, word, ptr, bMatched, bytes_buffer, bytes_count
Dim j, k, data_count, score, ipage, txtptr, GotoNextPage, FoundPhrase, pageexists
for sw = 0 to numwords-1
'initialize the sw_results here, since redim won't do it
sw_results(sw) = 0
bSkipped = False
if (SearchWords(sw) = "") then
bSkipped = True
end if
if (len(SearchWords(sw)) < MinWordLen) then
SkipSearchWord(sw)
bSkipped = True
end if
if (bSkipped = False) then
ExactPhrase = 0
UseWildCards = 0
ExcludeTerm = 0
if (ToLowerSearchWords = 1) then
SearchWords(sw) = Lcase(SearchWords(sw))
end if
' Check exclusion searches
if (Left(SearchWords(sw), 1) = "-") then
SearchWords(sw) = Right(SearchWords(sw), len(SearchWords(sw))-1)
SearchWords(sw) = Trim(SearchWords(sw))
ExcludeTerm = 1
exclude_count = exclude_count + 1
end if
if (AllowExactPhrase = 1 AND InStr(SearchWords(sw), " ") <> 0) then
' initialise exact phrase matching for this search 'term'
Dim phrase_terms, num_phrase_terms, tmpid, wordmap_row, xbi
ExactPhrase = 1
phrase_terms = Split(SearchWords(sw), " ")
num_phrase_terms = UBound(phrase_terms)+1
if (num_phrase_terms > context_maxgoback) then
context_maxgoback = num_phrase_terms
end if
tmpid = 0
WordNotFound = 0
for j = 0 to num_phrase_terms-1
tmpid = GetDictID(phrase_terms(j))
if (tmpid = -1) then
WordNotFound = 1
exit for
end if
'Response.Write("dict: " & dict(1, tmpid))
wordmap_row =Int(dict(1, tmpid))
'Response.Write("wordmap_row:" & wordmap_row)
if (wordmap_row <> -1) then
bfp_wordmap.Position = wordmap_row
if (bfp_wordmap.EOS = True) then
exit for
end if
countbytes = GetBytes(bfp_wordmap, 2) - 1
redim preserve phrase_data_count(j)
phrase_data_count(j) = countbytes
redim xdata(2, countbytes)
for xbi = 0 to countbytes
xdata(0, xbi) = GetBytes(bfp_wordmap, 2)
xdata(1, xbi) = GetBytes(bfp_wordmap, 2)
xdata(2, xbi) = GetBytes(bfp_wordmap, 4)
redim preserve phrase_terms_data(j)
phrase_terms_data(j) = xdata
next
else
redim preserve phrase_data_count(j)
phrase_data_count(j) = 0
end if
next
' check whether there are any wildcards used
elseif (InStr(SearchWords(sw), "*") <> 0 OR InStr(SearchWords(sw), "?") <> 0) then
patternStr = ""
if (SearchAsSubstring = 0) then
patternStr = patternStr & "^"
end if
' new keyword pattern to match for
SearchWords(sw) = pattern2regexp(SearchWords(sw))
patternStr = patternStr & SearchWords(sw)
if (SearchAsSubstring = 0) then
patternStr = patternStr & "$"
end if
regExp.Pattern = patternStr
UseWildCards = 1
end if
if (WordNotFound <> 1) then
'Read in a line at a time from the keywords file
for zoomit = 0 to dict_count
word = dict(0, zoomit)
ptr = dict(1, zoomit)
if (ExactPhrase = 1) then
bMatched = phrase_terms(0) = Lcase(word)
elseif (UseWildCards = 0) then
if (SearchAsSubstring = 0) then
bMatched = SearchWords(sw) = Lcase(word)
else
bMatched = InStr(Lcase(word), SearchWords(sw))
end if
else
bMatched = regExp.Test(word)
end if
' word found but indicated to be not indexed or skipped
if (bMatched AND Int(ptr) = -1) then
if (UseWildCards = 0 AND SearchAsSubstring = 0) then
SkippedExactPhrase = 1
SkipSearchWord(sw)
exit for
else
'continue
bMatched = False ' do nothing until next iteration
end if
end if
if (bMatched) then
Dim ContextSeeks, maxptr, maxptr_term, xi, tmpdata, FoundFirstWord, pos
Dim BufferLen, buffer_bytesread, xword_id, bytesread, dict_id, bytes
'keyword found in dictionary
if (ExactPhrase = 1) then
data_count = phrase_data_count(0)
redim data(2, data_count)
data = phrase_terms_data(0)
ContextSeeks = 0
else
bfp_wordmap.Position = ptr
if (bfp_wordmap.EOS = True) then
exit for
end if
'first 2 bytes is data count
data_count = GetBytes(bfp_wordmap, 2) - 1 ' index from 0
redim data(2, data_count)
for j = 0 to data_count
'redim preserve data(2, j)
data(0, j) = GetBytes(bfp_wordmap, 2) 'score
data(1, j) = GetBytes(bfp_wordmap, 2) 'pagenum
data(2, j) = GetBytes(bfp_wordmap, 4) 'ptr
next
end if
sw_results(sw) = data_count
for j = 0 to data_count
score = Int(data(0, j))
ipage = data(1, j) 'pagenum
txtptr = data(2, j)
GotoNextPage = 0
FoundPhrase = 0
if (ExactPhrase = 1) then
maxptr = txtptr
maxptr_term = 0
' check if all of the other words in the phrase appears on this page
for xi = 1 to num_phrase_terms-1
' see if this word appears at all on this page, if not, we stop scanning page
' do not check for skipped words (data count value of zero)
if (phrase_data_count(xi) <> 0) then
' check wordmap for this search phrase to see if it appears on the current page
tmpdata = phrase_terms_data(xi)
for xbi = 0 to phrase_data_count(xi)
if (tmpdata(1, xbi) = data(1, j)) then
' intersection, this term appears on both pages, goto next term
' remember biggest pointer
if (tmpdata(2, xbi) > maxptr) then
maxptr = tmpdata(2, xbi)
maxptr_term = xi
end if
score = score + tmpdata(0, xbi)
exit for
end if
next
if (xbi > phrase_data_count(xi)) then ' if not found
GotoNextPage = 1
exit for
end if
end if
next
if (GotoNextPage <> 1) then
ContextSeeks = ContextSeeks + 1
if (ContextSeeks > MaxContextSeeks) then
Response.Write("" & STR_PHRASE_CONTAINS_COMMON_WORDS & " """ & SearchWords(sw) & """ ") & VbCrLf ' end results style tag
' Time the searching
if (Timing = 1 OR Logging = 1) then
ElapsedTime = Timer - StartTime
ElapsedTime = Round(ElapsedTime, 3)
if (Timing = 1) then
Response.Write("") exit for end if ' ok so this page contains all the words in the phrase FoundPhrase = 0 FoundFirstWord = 0 ' we goto the first occurance of the first word in pagetext pos = maxptr - ((maxptr_term+3) * MaxDictIDLen) ' assume 3 possible punct. ' do not seek further back than the occurance of the first word (avoid wrong page) if (pos < txtptr) then pos = txtptr end if bin_pagetext.Position = pos bytes_buffer = "" BufferLen = 256 buffer_bytesread = BufferLen ' now we look for the phrase within the context of this page Do for xi = 0 to num_phrase_terms-1 do xword_id = 0 bytesread = 0 do if (buffer_bytesread >= BufferLen) then bytes_buffer = bin_pagetext.Read(BufferLen) buffer_bytesread = 0 end if dict_id = 0 bytes = Midb(bytes_buffer, buffer_bytesread+1, 2) for k = 1 to 2 dict_id = dict_id + Ascb(Midb(bytes, k, 1)) * (256^(k-1)) next xword_id = xword_id + dict_id buffer_bytesread = buffer_bytesread + 2 bytesread = bytesread + 2 loop while (dict_id >= 65535) pos = pos + bytesread if (xword_id = 0 OR xword_id > dict_count) then exit for end if ' if punct. keep reading. loop while (xword_id <= DictReservedLimit AND pos < bin_pagetext.Size) if (Lcase(dict(0, xword_id)) <> phrase_terms(xi)) then exit for end if if (xi = 0) then FoundFirstWord = FoundFirstWord + 1 ' remember the position of the 'start' of this phrase txtptr = pos - bytesread end if next if (xi = num_phrase_terms) then ' exact phrase found FoundPhrase = 1 end if Loop while xword_id <> 0 AND FoundPhrase = 0 AND FoundFirstWord <= score end if if (FoundPhrase <> 1) then GotoNextPage = 1 end if end if ' check whether we should skip to next page or not if (GotoNextPage <> 1) then 'Check if page is already in output list pageexists = 0 if ipage < 0 OR ipage > pagesCount then Response.Write("Error: Page number too big. Make sure ALL index files are updated.") exit for end if if (ExcludeTerm = 1) then ' we clear out the score entry so that it'll be excluded res_table(0, ipage) = Int(0) elseif (Int(res_table(0, ipage)) = 0) then matches = matches + 1 res_table(0, ipage) = Int(res_table(0, ipage)) + score if (res_table(0, ipage) <= 0) then Response.Write("Score should not be negative: " & score & " ") end if res_table(2, ipage) = txtptr else if (Int(res_table(0, ipage)) > 10000) then ' take it easy if its too big (to prevent huge scores) res_table(0, ipage) = Int(res_table(0, ipage)) + 1 else res_table(0, ipage) = Int(res_table(0, ipage)) + score res_table(0, ipage) = Int(res_table(0, ipage)) * 2 end if 'store the next two searchword matches if (Int(res_table(1, ipage)) > 0 AND Int(res_table(1, ipage)) < MaxContextKeywords) then if (Int(res_table(3, ipage)) = 0) then res_table(3, ipage) = txtptr elseif (Int(res_table(4, ipage)) = 0) then res_table(4, ipage) = txtptr end if end if end if ' store the 'total terms matched' value res_table(1, ipage) = Int(res_table(1, ipage)) + 1 ' store the 'AND search terms matched' value if (res_table(5, ipage) = sw OR res_table(5, ipage) = sw-SkippedWords-exclude_count) then res_table(5, ipage) = Int(res_table(5, ipage)) + 1 end if end if next if (UseWildCards = 0 AND SearchAsSubstring = 0) then exit for end if end if next end if end if if (sw <> numwords-1) then bfp_wordmap.Position = 1 end if next 'Close the keywords file that was being used bfp_wordmap.Close if SkippedWords > 0 then Response.Write("" & STR_SKIPPED_FOLLOWING_WORDS & " " & SkippedOutputStr & " ") if (SkippedExactPhrase = 1) then Response.Write(STR_SKIPPED_PHRASE & ". ") end if Response.Write(" ") end if Dim oline, fullmatches, full_numwords, SomeTermMatches Dim IsFiltered oline = 0 fullmatches = 0 dim output() full_numwords = numwords - SkippedWords - exclude_count for zoomit = 0 to pagesCount Step 1 IsFiltered = False if (res_table(0, zoomit) > 0) then if (UseCats = 1 AND zoomcat <> -1) then if (Int(catpages(zoomit)) <> zoomcat) then IsFiltered = True end if end if if (IsFiltered = False) then 'if (res_table(1, zoomit) >= full_numwords) then if (res_table(5, zoomit) >= full_numwords) then fullmatches = fullmatches + 1 elseif (andq = 1) then ' AND search, filter out non-matching results IsFiltered = True end if end if if (IsFiltered = False) then ' copy if not filtered out redim preserve output(5, oline) output(0, oline) = zoomit output(1, oline) = res_table(0, zoomit) output(2, oline) = res_table(1, zoomit) output(3, oline) = res_table(2, zoomit) output(4, oline) = res_table(3, zoomit) output(5, oline) = res_table(4, zoomit) oline = oline + 1 end if end if Next matches = oline Dim lobound, hibound ' Sort the results if (matches > 1) then lobound = LBound(output, 2) hibound = UBound(output, 2) if (zoomsort = 1 AND UseDateTime = 1) then call ShellSortByDate(output, datetime) else call ShellSort(output) end if end if Dim query_out ' query_out is the zoomquery prepared to be passed in a URL. query_out = Server.URLEncode(zoomquery) 'Display search results Response.Write(" ")
if matches = 0 Then
Response.Write(STR_SUMMARY_NO_RESULTS_FOUND)
elseif numwords > 1 AND andq = 0 then
SomeTermMatches = matches - fullmatches
Response.Write(PrintNumResults(fullmatches) & " " & STR_SUMMARY_FOUND_CONTAINING_ALL_TERMS & " ")
if (SomeTermMatches > 0) then
Response.Write(PrintNumResults(SomeTermMatches) & " " & STR_SUMMARY_FOUND_CONTAINING_SOME_TERMS)
end if
elseif numwords > 1 AND andq = 1 then
Response.Write(PrintNumResults(fullmatches) & " " & STR_SUMMARY_FOUND_CONTAINING_ALL_TERMS)
else
Response.Write(PrintNumResults(matches) & " " & STR_SUMMARY_FOUND)
end if
Response.Write(" ") & VbCrlf
if (Spelling = 1) then
Dim spellfile, spell_count, sp_line, sp_linenum, sw_spcode, spcode
Dim SuggestionsCount, SuggestionFound, SuggestStr, word1, word2, word3
' load in spellings file
spellfile = split(ReadDatFile(zoomfso, "zoom_spelling.zdat"), chr(10))
spell_count = UBound(spellfile)-1
dim spell()
redim spell(4, spell_count)
for zoomit = 0 to spell_count
sp_line = Split(spellfile(zoomit), " ", 4)
sp_linenum = UBound(sp_line)
if (sp_linenum > 0) then
spell(0, zoomit) = sp_line(0)
spell(1, zoomit) = sp_line(1)
spell(2, zoomit) = 0
spell(3, zoomit) = 0
if (sp_linenum > 1) then
spell(2, zoomit) = sp_line(2)
if (sp_linenum > 2) then
spell(3, zoomit) = sp_line(3)
end if
end if
end if
next
' re-value spell_count in case of errors in dict file
spell_count = UBound(spell, 2)
Dim dictid, nextsuggest
SuggestionsCount = 0
SuggestStr = ""
word1 = ""
word2 = ""
word3 = ""
for sw = 0 to numwords-1
if (sw_results(sw) >= SpellingWhenLessThan) then
' this word has enough results
if (sw > 0) then
SuggestStr = SuggestStr & " "
end if
SuggestStr = SuggestStr & SearchWords(sw)
else
' this word returned less results than threshold, and requires spelling suggestions
sw_spcode = GetSPCode(SearchWords(sw))
if (Len(sw_spcode) > 0) then
SuggestionFound = 0
for zoomit = 0 to spell_count
spcode = spell(0, zoomit)
if (spcode = sw_spcode) then
j = 0
do while (SuggestionFound = 0 AND j < 3 AND spell(1+j, zoomit) > 0)
dictid = CLng(spell(1+j, zoomit))
word1 = dict(0, dictid)
if (LCase(word1) = LCase(SearchWords(sw))) then
' Check that it is not the same word
SuggestionFound = 0
else
SuggestionFound = 1
SuggestionsCount = SuggestionsCount + 1
if (numwords = 1) then ' single word search
nextsuggest = j+1
if (j < 1 AND spell(1+nextsuggest, zoomit) <> 0) then
dictid = spell(1+nextsuggest, zoomit)
word2 = dict(0, dictid)
if (LCase(word2) = LCase(SearchWords(sw))) then
word2 = ""
end if
end if
nextsuggest = nextsuggest+1
if (j < 2 AND spell(1+nextsuggest, zoomit) <> 0) then
dictid = spell(1+nextsuggest, zoomit)
word2 = dict(0, dictid)
if (LCase(word3) = LCase(SearchWords(sw))) then
word3 = ""
end if
end if
end if
end if
j = j + 1
loop
elseif (spcode > sw_spcode) then
exit for
end if
if (SuggestionFound = 1) then
exit for
end if
next
if (SuggestionFound = 1) then
if (sw > 0) then
SuggestStr = SuggestStr & " "
end if
SuggestStr = SuggestStr & word1 ' add string AFTER so we can preserve order of words
end if
end if
end if
next
if (SuggestionsCount > 0) then
Response.Write("") if (matches < 3) then if (andq = 1 AND numwords > 1) then Response.Write(" " & STR_POSSIBLY_GET_MORE_RESULTS & " " & STR_ANY_OF_TERMS & ". ") elseif (UseCats = 1 AND zoomcat <> -1) then Response.Write(" " & STR_POSSIBLY_GET_MORE_RESULTS & " " & STR_ALL_CATS & ". ") end if end if Response.Write(" " & STR_DIDYOUMEAN & " " & SuggestStr & "") if (Len(word2) > 0) then Response.Write(" or " & word2 & "") end if if (Len(word3) > 0) then Response.Write(" or " & word3 & "") end if ' Response.Write("? ") end if end if ' Number of pages of results Dim num_pages ' Round up numbers with CLng note that it rounds to nearest whole number, ie: 0.5 -> 0, 1.5 -> 2 if (matches MOD per_page = 0) then 'whole number num_pages = CLng(matches / per_page) else 'unwholey number num_pages = CLng((matches / per_page) + 0.5) end if if (num_pages > 1) then ' Response.Write("" & num_pages & " " & STR_PAGES_OF_RESULTS & " ") & VbCrlf end if ' Show sorting options if (matches > 1 AND UseDateTime = 1) then Response.Write(" ")
if (zoomsort = 1) then
Response.Write("" & STR_SORTBY_RELEVANCE & " / " & STR_SORTEDBY_DATE & "")
else
Response.Write("" & STR_SORTEDBY_RELEVANCE & " / " & STR_SORTBY_DATE & "")
end if
Response.Write(" ")
end if
Dim arrayline, result_limit, urlLink
' Determine current line of result from the $output array
if (zoompage = 1) then
arrayline = 0
else
arrayline = (zoompage - 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)
Response.Write("") & VbCrLf
Response.Write("")
if (DisplayNumber = 1) then
Response.Write("" & (arrayline+1) & ". ")
end if
urlLink = urls(ipage)
if (GotoHighlight = 1) then
if (SearchAsSubstring = 1) then
urlLink = AddParamToURL(urlLink, "zoom_highlightsub=" & query_out)
else
urlLink = AddParamToURL(urlLink, "zoom_highlight=" & query_out)
end if
end if
if (DisplayTitle = 1) then
Response.Write("")
if (Highlighting = 1) then
PrintHighlightDescription(titles(ipage))
else
Response.Write(titles(ipage))
end if
Response.Write("")
else
Response.Write("" & urls(ipage) & "")
end if
if (UseCats = 1) then
catindex = catpages(ipage)
Response.Write(" [" & catnames(catindex) & "]")
end if
Response.Write(" ") & VbCrlf
if (DisplayMetaDesc = 1) then
' print meta description
if (Len(descriptions(ipage)) > 2) then
Response.Write("")
if (Highlighting = 1) then
PrintHighlightDescription(descriptions(ipage))
else
Response.Write(descriptions(ipage))
end if
Response.Write(" ") & VbCrlf
end if
end if
if (DisplayContext = 1) then
Dim context_keywords, context_word_count, goback, gobackbytes, context_str
Dim last_startpos, last_endpos, FoundContext, origpos, startpos, word_id
Dim noSpaceForNextChar, noGoBack
' extract contextual page description
context_keywords = output(2, arrayline)
if (context_keywords > MaxContextKeywords) then
context_keywords = MaxContextKeywords
end if
context_word_count = Ceil(ContextSize / context_keywords)
goback = Int(context_word_count / 2)
gobackbytes = goback * MaxDictIDLen
if ((gobackbytes / 2) > (context_word_count - context_maxgoback - goback)) then ' 2 is MinDictIDLen
' go back less if potential for matched word to be outside the context range
' determine most bytes we should go back to fit the word in in case of all dict ID's were min. len.
gobackbytes = 2 * (context_word_count - context_maxgoback - goback)
' thus avoiding jumping into the middle of a multi-pair dictID value
goback = Int(gobackbytes / MaxDictIDLen)
' redetermine max bytes to jump back for this number of words
gobackbytes = goback * MaxDictIDLen
end if
last_startpos = 0
last_endpos = 0
FoundContext = 0
Response.Write("") & VbCrLf
for j = 0 to (context_keywords - 1) Step 1
origpos = output(3+j, arrayline)
startpos = origpos
if (gobackbytes < startpos) then
startpos = startpos - gobackbytes
noGoBack = 0
else
noGoBack = 1
end if
'startpos = startpos - (2 * MaxDictIDLen) ' at least 2 words back
'startpos = startpos - gobackbytes
'Response.Write("seeking: " & startpos)
'if (startpos < 0) then
' startpos = 0
'end if
' do not overlap with previous extract
if (startpos > last_startpos AND startpos < last_endpos) then
startpos = last_endpos
end if
bin_pagetext.Position = startpos
if (bin_pagetext.EOS = True) then
exit for
end if
'remember last start position
last_startpos = startpos
word_id = GetNextDictWord(bin_pagetext)
context_str = ""
noSpaceForNextChar = False
for zoomit = 0 to context_word_count
if (noSpaceForNextChar = False) then
'if (word_id > DictReservedLimit) then
'No space for reserved words (punctuation, etc)
if (word_id > DictReservedNoSpaces) then
context_str = context_str + " "
elseif (word_id > DictReservedSuffixes AND word_id <= DictReservedPrefixes) then
context_str = context_str + " "
noSpaceForNextChar = True
elseif (word_id > DictReservedPrefixes) then
noSpaceForNextChar = True
end if
else
noSpaceForNextChar = False
end if
if (word_id = 0 OR word_id = 1 OR word_id > dict_count) then
'if (zoomit > goback OR noGoBack = 1) then
if (noGoBack = 1 OR bin_pagetext.Position > origpos) then
exit for
else
context_str = ""
zoomit = 0
end if
else
context_str = context_str + dict(0, word_id)
end if
word_id = GetNextDictWord(bin_pagetext)
next
' rememeber the last end position
last_endpos = bin_pagetext.Position
if (Trim(titles(ipage)) = Trim(context_str)) then
context_str = ""
end if
if (context_str <> "") then
Response.Write(" ... ")
FoundContext = 1
if (Highlighting = 1) then
PrintHighlightDescription(context_str)
else
Response.Write(context_str)
end if
end if
next
if (FoundContext = 1) then
Response.Write(" ...")
end if
Response.Write(" ") & VbCrLf
end if
Dim info_str
info_str = ""
if (DisplayTerms = 1) then
info_str = info_str & STR_RESULT_TERMS_MATCHED & " " & output(2, arrayline)
end if
if (DisplayScore = 1) then
if (len(info_str) > 0) then
info_str = info_str & " - "
end if
info_str = info_str & STR_RESULT_SCORE & " " & score
end if
if (DisplayDate = 1) then
if (len(info_str) > 0) then
info_str = info_str & " - "
end if
info_str = info_str & DatePart("d", datetime(ipage)) & " " & MonthName(DatePart("m", datetime(ipage)), true) & " " & DatePart("yyyy", datetime(ipage))
end if
if (DisplayURL = 1) then
if (len(info_str) > 0) then
info_str = info_str & " - "
end if
info_str = info_str & STR_RESULT_URL & " " & urls(ipage)
end if
Response.Write("")
Response.Write(info_str)
Response.Write(" ") & VbCrlf
arrayline = arrayline + 1
loop
if (DisplayContext = 1 OR AllowExactPhrase = 1) then
bin_pagetext.Close
end if
'Show links to other result pages
if (num_pages > 1) then
Dim start_range, end_range
' 10 results to the left of the current page
start_range = zoompage - 10
if (start_range < 1) then
start_range = 1
end if
' 10 to the right
end_range = zoompage + 10
if (end_range > num_pages) then
end_range = num_pages
end if
Response.Write("" & STR_RESULT_PAGES & " ")
if (zoompage > 1) then
Response.Write("<< " & STR_RESULT_PAGES_PREVIOUS & " ")
end if
'for zoomit = 1 to num_pages
for zoomit = start_range to end_range
if (Int(zoomit) = Int(zoompage)) then
Response.Write(zoompage & " ")
else
Response.Write("" & zoomit & " ")
end if
next
if (Int(zoompage) <> Int(num_pages)) then
Response.Write("" & STR_RESULT_PAGES_NEXT & " >> ")
end if
end if
Response.Write("" & STR_SEARCH_TOOK & " " & ElapsedTime & " " & STR_SECONDS & " ") end if end if 'Log the search words, if required if (Logging = 1) then LogQuery = Replace(zoomquery, """", """""") DateString = Year(Now) & "-" & Right("0" & Month(Now), 2) & "-" & Right("0" & Day(Now), 2) & ", " & Right("0" & Hour(Now), 2) & ":" & Right("0" & Minute(Now), 2) & ":" & Right("0" & Second(Now), 2) LogString = DateString & ", " & Request.ServerVariables("REMOTE_ADDR") & ", """ & LogQuery & """, Matches = " & matches if (andq = 1) then LogString = LogString & ", AND" else LogString = LogString & ", OR" end if if (NewSearch = 1) then zoompage = 0 end if LogString = LogString & ", PerPage = " & per_page & ", PageNum = " & zoompage if (UseCats = 0) then LogString = LogString & ", No cats" else if (zoomcat = -1) then LogString = LogString & ", ""Cat = All""" else logCatStr = catnames(zoomcat) logCatStr = Replace(logCatStr, """", """""") ' replace " with "" LogString = LogString & ", ""Cat = "& logCatStr & """" end if end if ' avoid problems with languages with "," as decimal pt breaking log file format. ElapsedTime = Replace(ElapsedTime, ",", ".") LogString = LogString & ", Time = " & ElapsedTime ' end of record LogString = LogString & VbCrLf on error resume next set logfile = zoomfso.OpenTextFile(MapPath(LogFileName), 8, True, 0) if (Err.Number <> 0) then Response.Write("Unable to write to log file (" & MapPath(LogFileName) & "). Check that you have specified the correct log filename in your Indexer settings and that you have the required file permissions set. ") else logfile.Write(LogString) logfile.Close end if on error goto 0 end if ' Logging end if ' NoSearch 'Print out the end of the template call PrintEndOfTemplate %> |