<% ' ---------------------------------------------------------------------------- ' Zoom Search Engine 3.0 (19/5/2004) ' Standard version for ASP ' A fast custom website search engine ' Copyright (C) Wrensoft 2000 - 2003 ' ' email: zoom@wrensoft.com ' www: http://www.wrensoft.com ' ---------------------------------------------------------------------------- ' Check for dependant files set fso = CreateObject("Scripting.FileSystemObject") if (fso.FileExists(Server.MapPath("settings.asp")) = False OR fso.FileExists(Server.MapPath("zoom_wordmap.zdat")) = FALSE OR fso.FileExists(Server.MapPath("zoom_dictionary.zdat")) = FALSE OR fso.FileExists(Server.MapPath("zoom_pages.zdat")) = FALSE OR fso.FileExists(Server.MapPath("zoom_titles.zdat")) = FALSE) then Response.Write("Zoom files missing error: Zoom is missing one or more of the required index data files.
") Response.Write("Please make sure the generated index files are uploaded to the same path as this search script.
") Response.End end if ' ---------------------------------------------------------------------------- ' Settings (change if necessary) ' ---------------------------------------------------------------------------- ' The options available in the dropdown menu for number of results ' per page PerPageOptions = Array(10, 20, 50, 100) FormFormat = 0 ' ---------------------------------------------------------------------------- ' Parameter initialisation ' ---------------------------------------------------------------------------- ' 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 NewSearch = 0 if Request.QueryString("zoom_page").Count <> 0 then page = Request.QueryString("zoom_page") else page = 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") else andq = 0 end if ' categories if Request.QueryString("zoom_cat").Count <> 0 then cat = Int(Request.QueryString("zoom_cat")) else cat = -1 end if if (IsEmpty(LinkBackURL)) then selfURL = Request.ServerVariables("URL") else selfURL = LinkBackURL end if target = "" if (UseLinkTarget = 1) then target = " target=""" & LinkTarget & """ " 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 if (InStr(pattern, "#") <> False) then pattern = Replace(pattern, "#", "\#") end if if (InStr(pattern, "$") <> False) then pattern = Replace(pattern, "$", "\$") end if pattern = Replace(pattern, ".", "\.") pattern = Replace(pattern, "*", "[\d\w]*") pattern = Replace(pattern, "?", ".") pattern2regexp = pattern 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 Sub SkipSearchWord(sw) if (SearchWords(sw) <> "") then if (SkippedWords > 0) then SkippedOutputStr = SkippedOutputStr & ", " end if SkippedOutputStr = SkippedOutputStr & """" & SearchWords(sw) & """" SearchWords(sw) = "" end if SkippedWords = SkippedWords + 1 End Sub Function PrintHighlightDescription(line) For i = 0 to numwords-1 regExp.Pattern = "(\W|^|\b)(" & SearchWords(i) & ")(\W|$|\b)" line = regExp.Replace(line, "$1[;:]$2[:;]$3") Next line = replace(line, "[;:]", "") line = replace(line, "[:;]", "") Response.Write(line) End Function Function PrintNumResults(num) if (num = 0) then PrintNumResults = "No results" elseif (num = 1) then PrintNumResults = num & " result" else PrintNumResults = num & " results" end if 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 Sub ShellSort(array) last = UBound(array, 2) first = LBound(array, 2) num = last - first + 1 ' find the best value for distance do distance = distance * 3 + 1 loop until (distance > num) do distance = distance \ 3 for index = (distance + first) to last value = array(1, index) value0 = array(0, index) value2 = array(2, index) value3 = array(3, index) value4 = array(4, index) value5 = array(5, index) index2 = index do while (index2 - distance => first) if (array(2, index2 - distance) > value2) then exit do end if if (array(2, index2 - distance) = value2) then if (array(1, index2 - distance) >= value) then exit do end if end if array(0, index2) = array(0, index2 - distance) array(1, index2) = array(1, index2 - distance) array(2, index2) = array(2, index2 - distance) array(3, index2) = array(3, index2 - distance) array(4, index2) = array(4, index2 - distance) array(5, index2) = array(5, index2 - distance) index2 = index2 - distance loop array(1, index2) = value array(0, index2) = value0 array(2, index2) = value2 array(3, index2) = value3 array(4, index2) = value4 array(5, index2) = value5 next loop until distance = 1 End Sub Function GetBytes(binfile, bytes) bytes_buffer = binfile.Read(bytes) GetBytes = 0 bytes_count = LenB(bytes_buffer) for k = 1 to bytes_count GetBytes = GetBytes + Ascb(Midb(bytes_buffer, k, 1)) * (256^(k-1)) next End Function Function GetNextDictWord(bin_pagetext) GetNextDictWord = 0 do dict_id = GetBytes(bin_pagetext, 2) GetNextDictWord = GetNextDictWord + dict_id loop while (dict_id >= 65535 AND bin_pagetext.EOS <> True) End Function Function GetDictID(word) GetDictID = -1 for i = 0 to dict_count if (LCase(dict(0, i)) = LCase(word)) then GetDictID = i exit for end if next End Function ' Custom read file method to avoid TextStream's ReadAll function ' which fails to scale reliably on certain machines/setups. function ReadDatFile(fso, filename) set fileObj = fso.GetFile(Server.MapPath(filename)) set tsObj = fileObj.OpenAsTextStream(1, 0) ReadDatFile = tsObj.Read(fileObj.Size) tsObj.Close end function ' Debug stop watches to time performance of sub-sections Dim StopWatch(10) TimerCount = 0 DebugTimerSum = 0 sub StartTimer() StopWatch(TimerCount) = timer TimerCount = TimerCount + 1 end sub function StopTimer() EndTime = Timer TimerCount = TimerCount - 1 StopTimer = EndTime - StopWatch(TimerCount) end function ' ---------------------------------------------------------------------------- ' Main starts here ' ---------------------------------------------------------------------------- ' For timing of the search if (Timing = 1 OR Logging = 1) then Dim StartTime, ElapsedTime StartTime = Timer end if 'Open and print start of result page template set fp_template = fso.OpenTextFile(Server.MapPath(TemplateFilename), 1) ' find the "" string in the template html file dim line, templateFile do while fp_template.AtEndOfStream <> True line = fp_template.ReadLine & VbCrLf templateFile = templateFile & line loop fp_template.Close Template = split(templateFile, "") Response.Write(Template(0)) & VbCrLf '' Check for category files if (UseCats = 1) then if (fso.FileExists(Server.MapPath("zoom_cats.zdat")) = True) AND (fso.FileExists(Server.MapPath("zoom_catpages.zdat")) = True) then ' Loads the entire categories page into an array catnames = split(ReadDatFile(fso, "zoom_cats.zdat"), chr(13) & chr(10)) catpages = split(ReadDatFile(fso, "zoom_catpages.zdat"), chr(13) & chr(10)) else Response.Write("Missing file(s) zoom_cats.zdat and zoom_catpages.zdat required for category enabled search mode") Response.End end if end if ' Replace the key text with the following if (FormFormat > 0) then 'hw ' Insert the form Response.Write("
") & VbCrlf Response.Write("

Search for: ") & VbCrlf Response.Write(" ") & VbCrlf if (FormFormat = 2) then Response.Write("Results per page:") & VbCrlf Response.Write("

") & VbCrlf if (UseCats = 1) then Response.Write("Category: ") & VbCrlf Response.Write("  ") & VbCrlf end if Response.Write("Match: ") if (andq = 0) then Response.Write("any search words") & VbCrlf Response.Write("all search words") & VbCrlf else Response.Write("any search words") & VbCrlf Response.Write("all search words") & VbCrlf end if Response.Write("") & VbCrlf end if 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 ' Load index data files (*.zdat) ---------------------------------------------- ' Load the entire pages file into an array, all URL's on the site urls = split(ReadDatFile(fso, "zoom_pages.zdat"), chr(13) & chr(10)) ' Load the entire page titles file into an array titles = split(ReadDatFile(fso, "zoom_titles.zdat"), chr(13) & chr(10)) if ResultFormat = 1 OR ResultFormat = 3 then descriptions = split(ReadDatFile(fso, "zoom_descriptions.zdat"), chr(13) & 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 in ""setting.asp""
") Response.Write("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 (ResultFormat = 2 OR ResultFormat = 3) then Dim bin_pagetext set bin_pagetext = CreateObject("ADODB.Stream") bin_pagetext.Type = 1 ' stream type = binary bin_pagetext.Open ' open stream bin_pagetext.LoadFromFile Server.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 in ""setting.asp""
") Response.Write("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(fso, "zoom_dictionary.zdat"), chr(13) & chr(10)) dict_count = UBound(dictfile)-1 dim dict() redim dict(2, dict_count) for i = 0 to dict_count dictline = Split(dictfile(i), " ") if (UBound(dictline) = 1) then dict(0, i) = dictline(0) dict(1, i) = 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 Server.MapPath("zoom_wordmap.zdat") 'Initialise regular expression object set regExp = New RegExp regExp.Global = True if (ToLowerSearchWords = 0) then regExp.IgnoreCase = False else regExp.IgnoreCase = True end if ' Prepare query for search ----------------------------------------------------- 'Split search phrase into words if (MapAccents = 1) then For i = 0 to UBound(NormalChars) query = Replace(query, AccentChars(i), NormalChars(i)) Next end if if (AllowExactPhrase = 0) then query = Replace(query, """", " ") end if if (InStr(WordJoinChars, ".") = False) then query = Replace(query, ".", " ") end if if (InStr(WordJoinChars, "-") = False) then query = Replace(query, "-", " ") end if if (InStr(WordJoinChars, "_") = False) then query = Replace(query, "_", " ") end if if (InStr(WordJoinChars, "'") = False) then query = Replace(query, "'", " ") end if if (InStr(WordJoinChars, "#") = False) then query = Replace(query, "#", " ") end if if (InStr(WordJoinChars, "$") = False) then query = Replace(query, "$", " ") end if if (InStr(WordJoinChars, ",") = False) then query = Replace(query, ",", " ") end if ' Split exact phrase terms if found dim SearchWords, quote_terms, term quote_terms = Array() tmp_query = query if (InStr(query, """")) then regExp.Pattern = """.*?""" set quote_terms = regExp.Execute(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(" ", "_", "[", "]", "+", ",")) i = UBound(SearchWords) for each term in quote_terms i = i + 1 redim preserve SearchWords(i) SearchWords(i) = Replace(term, """", "") next 'Print heading Response.Write("
Search results for: " & Server.HTMLEncode(query)) if (UseCats = 1) then if (cat = -1) then Response.Write(" in all categories") else Response.Write(" in category """ & catnames(cat) & """") end if end if Response.Write("

") & VbCrlf Response.Write("
") & VbCrLf ' Begin main search loop ------------------------------------------------------ 'Loop through all search words numwords = UBound(SearchWords)+1 outputline = 0 'default to use wildcards UseWildCards = 1 ' Check for skipped words in search query SkippedWords = 0 SkippedOutputStr = "" 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 for sw = 0 to numwords-1 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 if (ToLowerSearchWords = 1) then SearchWords(sw) = Lcase(SearchWords(sw)) end if ExactPhrase = 0 UseWildCards = 0 if (AllowExactPhrase = 1 AND InStr(SearchWords(sw), " ") <> 0) then ' initialise exact phrase matching for this search 'term' ExactPhrase = 1 phrase_terms = Split(SearchWords(sw), " ") num_phrase_terms = UBound(phrase_terms) tmpid = 0 WordNotFound = 0 for j = 0 to num_phrase_terms 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 i = 0 to dict_count word = dict(0, i) ptr = dict(1, i) 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 SkipSearchWord(sw) exit for else 'continue bMatched = False ' do nothing until next iteration end if end if if (bMatched) then '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 if (bfp_wordmap.EOS = True) then exit for end if end if 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 ' 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("The phrase """ & SearchWords(sw) & """ contains very common words on this site, resulting in a limited search. Please define a more specific phrase for better results.

") 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 bin_pagetext.Position = maxptr - (maxptr_term * MaxDictIDLen) bytes_buffer = "" BufferLen = 256 bytes_read = BufferLen ' now we look for the phrase within the context of this page Do for xi = 0 to num_phrase_terms do do if (bytes_read >= BufferLen) then pos = bin_pagetext.Position bytes_buffer = bin_pagetext.Read(BufferLen) bytes_read = 0 end if xword_id = 0 bytes = Midb(bytes_buffer, bytes_read+1, 2) for k = 1 to 2 xword_id = xword_id + Ascb(Midb(bytes, k, 1)) * (256^(k-1)) next bytes_read = bytes_read + 2 loop while (xword_id >= 65535) 'xword_id = GetNextDictWord(bin_pagetext) if (xword_id = 0 OR xword_id > dict_count) then exit for end if loop while (xword_id < DictReservedLimit) ' if punct. keep reading. 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 + bytes_read - MaxDictIDLen 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("problem: page number too big. stopping.") exit for end if if (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) 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 > 1 then Response.Write("The following words are in the skip word list and have been omitted from your search: " & SkippedOutputStr & "

") elseif SkippedWords > 0 then Response.Write("The word " & SkippedOutputStr & " is in the skip word list, and has been omitted from your search.

") end if oline = 0 fullmatches = 0 ResFiltered = False dim output() full_numwords = numwords - SkippedWords for i = 0 to pagesCount Step 1 IsFiltered = False if (res_table(0, i) > 0) then if (UseCats = 1 AND cat <> -1) then if (Int(catpages(i)) <> cat) then IsFiltered = True end if end if if (IsFiltered = False) then 'if (res_table(1, i) >= full_numwords) then if (res_table(5, i) >= 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) = i output(1, oline) = res_table(0, i) output(2, oline) = res_table(1, i) output(3, oline) = res_table(2, i) output(4, oline) = res_table(3, i) output(5, oline) = res_table(4, i) oline = oline + 1 else ResFiltered = True end if end if Next If (ResFiltered = True) then matches = oline End if ' Sort the results if (matches > 1) then lobound = LBound(output, 2) hibound = UBound(output, 2) call ShellSort(output) end if 'Display search results Response.Write("
") if matches = 0 Then Response.Write("No results found.") elseif numwords > 1 AND andq = 0 then SomeTermMatches = matches - fullmatches Response.Write(PrintNumResults(fullmatches) & " found containing all search terms. ") if (SomeTermMatches > 0) then Response.Write(PrintNumResults(SomeTermMatches) & " found containing some search terms.") end if elseif numwords > 1 AND andq = 1 then Response.Write(PrintNumResults(fullmatches) & " found containing all search terms.") else Response.Write(PrintNumResults(matches) & " 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 = 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 & " 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 (ResultFormat = 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 (UseCats = 1) then catindex = catpages(ipage) Response.Write("[" & catnames(catindex) & "]") end if Response.Write("
") & VbCrlf end if if (ResultFormat = 1 OR ResultFormat = 3) 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 (ResultFormat = 2 OR ResultFormat = 3) then ' extract contextual page description context_keywords = output(2, arrayline) if (context_keywords > MaxContextKeywords) then context_keywords = MaxContextKeywords end if context_word_count = Int(ContextSize / context_keywords) goback = Int(context_word_count / 2) gobackbytes = goback * MaxDictIDLen if ((gobackbytes / 2) > (context_word_count - 1)) then ' 2 is MinDictIDLen ' go back less if potential for matched word to be outside the context range gobackbytes = 2 * (context_word_count - 1) goback = Int(gobackbytes / MaxDictIDLen) end if last_startpos = 0 last_endpos = 0 Response.Write("
") & VbCrLf for j = 0 to (context_keywords - 1) Step 1 startpos = output(3+j, arrayline) '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) Response.Write(" ... ") context_str = "" noSpaceForNextChar = False for i = 0 to context_word_count if (noSpaceForNextChar = False) then if (word_id > DictReservedLimit) 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 > dict_count) then if (i > goback) then exit for else context_str = "" 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 (Highlighting = 1) then PrintHighlightDescription(context_Str) else Response.Write(context_str) end if next Response.Write(" ...
") & VbCrLf end if Response.Write("
Terms matched: " & output(2, arrayline) & " - Score: " & score & " - URL: " & urls(ipage) & "

") & VbCrlf arrayline = arrayline + 1 loop if (ResultFormat = 2 OR ResultFormat = 3) then bin_pagetext.Close end if 'Show links to other result pages ' manually prepare query for links 'query_out = Replace(query, " ", "+") 'query_out = Server.HTMLEncode(query_out) query_out = Server.URLEncode(query) if (num_pages > 1) then ' 10 results to the left of the current page start_range = page - 10 if (start_range < 1) then start_range = 1 end if ' 10 to the right end_range = page + 10 if (end_range > num_pages) then end_range = num_pages end if Response.Write("

Result Pages: ") if (page > 1) then Response.Write("<< Previous ") end if 'for i = 1 to num_pages for i = start_range to end_range if (Int(i) = Int(page)) then Response.Write(page & " ") else Response.Write("" & i & " ") end if next if (Int(page) <> Int(num_pages)) then Response.Write("Next >> ") end if end if Response.Write("

") & 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("

Search took " & ElapsedTime & " seconds") end if end if 'Print out the end of the template call PrintEndOfTemplate 'Log the search words, if required if (Logging = 1) then LogQuery = Replace(query, """", """""") 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 page = 0 end if LogString = LogString & ", PerPage = " & per_page & ", PageNum = " & page if (UseCats = 0) then LogString = LogString & ", No cats" else if (cat = -1) then LogString = LogString & ", ""Cat = All""" else logCatStr = catnames(cat) 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 = fso.OpenTextFile(Server.MapPath(LogFileName), 8, True, 0) if (Err.Number <> 0) then Response.Write("Log filename and path not found. Check that you specified the correct log filename in your Indexer settings.
") else logfile.Write(LogString) logfile.Close end if end if %>