<% ' ---------------------------------------------------------------------------- ' Zoom Search Engine 4.0 (13/12/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 ' ---------------------------------------------------------------------------- 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 ' 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.
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) ' ---------------------------------------------------------------------------- ' Parameter initialisation ' ---------------------------------------------------------------------------- if (Len(Charset) > 0) then Response.Charset = Charset 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 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") elseif (IsEmpty(DefaultToAnd) = false AND DefaultToAnd = 1) then andq = 1 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 ' 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 sort = Int(Request.QueryString("zoom_sort")) else sort = 0 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("

" & STR_POWEREDBY & " 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\S]*") 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 if Len(SearchWords(i)) > 0 then if (SearchAsSubstring = 1) then regExp.Pattern = "(" & SearchWords(i) & ")" line = regExp.Replace(line, "[;:]$1[:;]") else regExp.Pattern = "(\W|^|\b)(" & SearchWords(i) & ")(\W|$|\b)" line = regExp.Replace(line, "$1[;:]$2[:;]$3") end if end if Next line = replace(line, "[;:]", "") line = replace(line, "[:;]", "") Response.Write(line) End Function Function PrintNumResults(num) if (num = 0) then PrintNumResults = STR_NO_RESULTS elseif (num = 1) then PrintNumResults = num & " " & STR_RESULT else PrintNumResults = num & " " & STR_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 Sub ShellSortByDate(array, datetime) 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 (cdate(datetime(array(0, index2 - distance))) > cdate(datetime(value0))) then exit do end if if (cdate(datetime(array(0, index2 - distance))) = cdate(datetime(value0))) then if (array(2, index2 - distance) >= value2) 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 function GetSPCode(word) ' initialize return variable GetSPCode = "" tmpword = LCase(word) 'strip out non alphabetic characters regExp.Pattern = "[^a-z]" tmpword = regExp.Replace(tmpword, "") wordlen = Len(tmpword) if wordlen < 1 then Exit Function end if GetSPCode = Left(tmpword, 1) tmpword = Right(tmpword, wordlen-1) tmpword = Replace(tmpword, "a", "0") tmpword = Replace(tmpword, "e", "0") tmpword = Replace(tmpword, "i", "0") tmpword = Replace(tmpword, "o", "0") tmpword = Replace(tmpword, "u", "0") tmpword = Replace(tmpword, "h", "0") tmpword = Replace(tmpword, "w", "0") tmpword = Replace(tmpword, "y", "0") tmpword = Replace(tmpword, "b", "1") tmpword = Replace(tmpword, "p", "1") tmpword = Replace(tmpword, "f", "1") tmpword = Replace(tmpword, "v", "1") tmpword = Replace(tmpword, "c", "2") tmpword = Replace(tmpword, "g", "2") tmpword = Replace(tmpword, "j", "2") tmpword = Replace(tmpword, "k", "2") tmpword = Replace(tmpword, "q", "2") tmpword = Replace(tmpword, "s", "2") tmpword = Replace(tmpword, "x", "2") tmpword = Replace(tmpword, "z", "2") tmpword = Replace(tmpword, "d", "3") tmpword = Replace(tmpword, "t", "3") tmpword = Replace(tmpword, "l", "4") tmpword = Replace(tmpword, "m", "5") tmpword = Replace(tmpword, "n", "5") tmpword = Replace(tmpword, "r", "6") ' Remove any adjacent digits char = "" nextChar = "" tmpstr = "" for i = 1 to wordlen char = Mid(tmpword, i, 1) nextChar = Mid(tmpword, (i + 1), 1) if (IsNumeric(char) AND char <> nextChar) then tmpstr = tmpstr + char end if next tmpword = tmpstr If (Len(tmpword) < 1) Then Exit Function End If tmpword = Replace(tmpword, "0", "") ' Pad to 4 characters with zeroes if (Len(tmpword) < 4) then tmpword = tmpword & "0000" end if GetSPCode = GetSPCode & Mid(tmpword, 1, 3) 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 Response.Write("") & VbCrLf ' Replace the key text with the following if (FormFormat > 0) then ' Insert the form Response.Write("
") & VbCrlf Response.Write(STR_FORM_SEARCHFOR & " ") & VbCrlf Response.Write(" ") & VbCrlf if (FormFormat = 2) then Response.Write("" & STR_FORM_RESULTS_PER_PAGE) & VbCrlf Response.Write("

") & VbCrlf if (UseCats = 1) then Response.Write(STR_FORM_CATEGORY & " ") & VbCrlf Response.Write("  ") & VbCrlf end if Response.Write(STR_FORM_MATCH & " ") if (andq = 0) then Response.Write("" & STR_FORM_ANY_SEARCH_WORDS) & VbCrlf Response.Write("" & STR_FORM_ALL_SEARCH_WORDS) & VbCrlf else Response.Write("" & STR_FORM_ANY_SEARCH_WORDS) & VbCrlf Response.Write("" & STR_FORM_ALL_SEARCH_WORDS) & VbCrlf end if Response.Write("") & VbCrLf Response.Write("
") & VbCrlf else Response.Write("") & VbCrLf Response.Write("") & VbCrLf Response.Write("") & VbCrLf end if Response.Write("
") & VbCrlf end if ' Give up early if no search words provided NoSearch = 0 if (Len(query) = 0) then if (FormFormat = 0) then Response.Write(STR_NO_QUERY & "
") 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) ---------------------------------------------- ' 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 (DisplayMetaDesc = 1) 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.
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(fso, "zoom_datetime.zdat"), chr(13) & chr(10)) dates_count = UBound(datefile)-1 dim datetime() redim datetime(dates_count) for i = 0 to dates_count datetime(i) = CDate(datefile(i)) next end if if (DisplayContext = 1 OR AllowExactPhrase = 1) 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.
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 query = Replace(query, "/", " ") query = Replace(query, "\", " ") ' 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("
" & STR_RESULTS_FOR & " " & Server.HTMLEncode(query)) if (UseCats = 1) then if (cat = -1) then Response.Write(" " & STR_RESULTS_IN_ALL_CATEGORIES) else Response.Write(" " & STR_RESULTS_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 = "" 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 context_maxgoback = 1 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) 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 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 SkippedExactPhrase = 1 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("" & STR_PHRASE_CONTAINS_COMMON_WORDS & " """ & SearchWords(sw) & """

") 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 bytes_read = BufferLen ' now we look for the phrase within the context of this page Do for xi = 0 to num_phrase_terms do xword_id = 0 do if (bytes_read >= BufferLen) then pos = bin_pagetext.Position bytes_buffer = bin_pagetext.Read(BufferLen) bytes_read = 0 end if dict_id = 0 bytes = Midb(bytes_buffer, bytes_read+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 bytes_read = bytes_read + 2 loop while (dict_id >= 65535) 'xword_id = GetNextDictWord(bin_pagetext) if (xword_id = 0 OR xword_id > dict_count) then exit for end if ' if punct. keep reading. loop while (xword_id <= DictReservedLimit AND bin_pagetext.EOS <> True) 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 txtptr = pos 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 OR res_table(5, ipage) = sw-SkippedWords) 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 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) if (sort = 1 AND UseDateTime = 1) then call ShellSortByDate(output, datetime) else call ShellSort(output) end if end if ' query_out is the query prepared to be passed in a URL. query_out = Server.URLEncode(query) '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("
") 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 cat <> -1) then Response.Write("
" & STR_POSSIBLY_GET_MORE_RESULTS & " " & STR_ALL_CATS & ".
") end if end if Response.Write("
") & VbCrlf if (Spelling = 1 AND matches < SpellingWhenLessThan) then ' load in spellings file spellfile = split(ReadDatFile(fso, "zoom_spelling.zdat"), chr(13) & chr(10)) spell_count = UBound(spellfile)-1 dim spell() redim spell(2, spell_count) for i = 0 to spell_count sp_line = Split(spellfile(i), " ") if (UBound(sp_line) = 1) then spell(0, i) = sp_line(0) spell(1, i) = sp_line(1) end if next ' re-value spell_count in case of errors in dict file spell_count = UBound(spell, 2) SuggestionsCount = 0 SuggestStr = "" for sw = 0 to numwords-1 ' word does not match, check if it is a candidate to be a suggestion sw_spcode = GetSPCode(SearchWords(sw)) if (Len(sw_spcode) = 4) then SuggestionFound = 0 for i = 0 to spell_count spcode = spell(0, i) dictid = spell(1, i) word = dict(0, dictid) ptr = dict(1, dictid) if (spcode = sw_spcode) then if ((Int(ptr) = -1) OR (LCase(word) = LCase(SearchWords(sw)))) then ' Check that it is not a skipped word or the same word SuggestionFound = 0 exit for else SuggestionFound = 1 SuggestionsCount = SuggestionsCount + 1 end if elseif (spcode > sw_spcode) then exit for end if if (SuggestionFound = 1) then exit for end if next if (sw > 0) then SuggestStr = SuggestStr & " " end if if (SuggestionFound = 1) then SuggestStr = SuggestStr & word ' add string AFTER so we can preserve order of words else SuggestStr = SuggestStr & SearchWords(sw) end if end if next if (SuggestionsCount > 0) then suggeststr_out = Server.URLEncode(SuggestStr) Response.Write("
" & STR_DIDYOUMEAN & " " & SuggestStr & "?
") end if end if ' Number of pages of results ' 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 (sort = 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 ' 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) Response.Write("

") & VbCrLf Response.Write("
") if (DisplayNumber = 1) then Response.Write("" & (arrayline+1) & ". ") 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 ' 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 - 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 i = 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 > dict_count) then 'if (i > goback OR noGoBack = 1) then if (noGoBack = 1 OR bin_pagetext.Position > origpos) then exit for else context_str = "" i = 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 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 ' 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("

" & STR_RESULT_PAGES & " ") if (page > 1) then Response.Write("<< " & STR_RESULT_PAGES_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("" & STR_RESULT_PAGES_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("

" & STR_SEARCH_TOOK & " " & ElapsedTime & " " & STR_SECONDS & "
") end if end if '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 ' Logging end if ' NoSearch 'Print out the end of the template call PrintEndOfTemplate %>