<% ' ---------------------------------------------------------------------------- ' Zoom Search Engine 2.0 (18/8/2003) ' Standard version for ASP ' A fast custom website search engine ' Copyright (C) Wrensoft 2000 - 2003 ' ' email: zoom@wrensoft.com ' www: http://www.wrensoft.com ' ---------------------------------------------------------------------------- ' ---------------------------------------------------------------------------- ' Settings (change if necessary) ' ---------------------------------------------------------------------------- ' Highlight matched words in results Highlighting = 0 ' 0 = off, 1 = on HighlightColor = "#FFFF40" ' Highlight colour ' Set this to your template HTML page ' (for the formatting and location of the search form) TemplateFilename = "search_template.html" ' The options available in the dropdown menu for number of results ' per page PerPageOptions = Array(10, 20, 50, 100) FormFormat = 2 '0 = No search form (note that you must pass parameters to ' the script directly from elsewhere on your website). '1 = Basic search form '2 = Advanced search form (with options) ZoomInfo = 1 '0 = Don't display Zoom info line at bottom of search '1 = Display Zoom info line at bottom of search OutputStyle = 1 '0 = Basic Style, Page Title, Score and URL '1 = Descriptive Stlye, Match number, Page Title, ' Page description, Score and URL Logging = 0 '0 = No logging of words that a user enter. '1 = Words are logged to a file for later analysis. (See ' documentation for file permission issues) LogFileName = ".\logs\searchwords.log" 'Path and File name of search word log file MaxKeyWordLineLen = 2000 'Maximum line length of a single line in the KeyWords file. 'Increase, if required, so that 'MaxKeyWordLineLen >= Number of web pages in site * 6 WordSplit = 1 '0 = Only split input search phrase into words when a ' Space character is found '1 = Split input search phrase at Space ' ', ' UnderScore '_' , Dash '-' and Plus '+' characters Timing = 0 '0 = don't display timing results of search '1 = display timing results ' ---------------------------------------------------------------------------- ' Parameter initilisation ' ---------------------------------------------------------------------------- ' for compatibility with Zoom < 2.0 HTML forms ' using the POST 'searchword' parameter if Request.Form("searchword").Count = 1 then query = Request.Form("searchword") end if ' we use the method=GET and 'query' parameter now (for sub-result pages etc) if Request.QueryString("zoom_query").Count <> 0 then query = Request.QueryString("zoom_query") end if ' number of results per page, defaults to 10 if not specified if Request.QueryString("zoom_per_page").Count <> 0 then per_page = Request.QueryString("zoom_per_page") else per_page = 10 end if ' current result page number, defaults to the first page if not specified if Request.QueryString("zoom_page").Count <> 0 then page = Request.QueryString("zoom_page") else page = 1 end if ' AND operator. ' 1 if we are searching for ALL terms ' 0 if we are searching for ANY terms (default) if Request.QueryString("zoom_and").Count <> 0 then andq = Request.QueryString("zoom_and") else andq = 0 end if selfURL = Request.ServerVariables("URL") if (Highlighting = 1) then dim matchwords() matchwords_num = 0 ReDim matchwords(0) ' ensures that it is an array for LBound to work end if Sub PrintEndOfTemplate 'Let others know about Zoom. if (ZoomInfo = 1) then Response.Write("

Search powered by Zoom Search Engine

") & VbCrlf end if if (UBound(Template) > 0) then 'If rest of template exists Response.Write(Template(1)) & VbCrLf end if End Sub ' Translate a wildcard pattern to a regexp pattern ' Supports '*' and '.' only at the moment. Function pattern2regexp(pattern) ' ASP/VBScript's RegExp has some 7-bit ASCII char issues ' and treats accented characters as an end of word for boundaries ("\b") ' So we use ^ and $ instead, since we're matching single words anyway pattern2regexp = "^" pattern = Replace(pattern, "*", ".*") pattern = Replace(pattern, "?", ".") pattern2regexp = pattern2regexp & pattern pattern2regexp = pattern2regexp + "$" End Function 'Returns true if a value is found within the array Function IsInArray(strValue, arrayName) Dim iLoop, bolFound IsInArray = False if (IsArray(arrayName) = False) then Exit Function End if For iLoop = LBound(arrayName) to UBound(arrayName) if (CStr(arrayName(iLoop)) = CStr(strvalue)) then IsInArray = True Exit Function end if Next End Function Function PrintHighlightDescription(line) For i = 0 to UBound(matchwords) 'replace with marker text, '[;:]' and '[:;]' regExp.Pattern = "\b(" & matchwords(i) & ")\b" line = regExp.Replace(line, "[;:]$1[:;]") Next line = replace(line, "[;:]", "") line = replace(line, "[:;]", "") Response.Write(line) End Function Function SplitMulti(string, delimiters) For i = 1 to UBound(delimiters) string = Replace(string, delimiters(i), delimiters(0)) Next string = Trim(string) 'for replaced quotes SplitMulti = Split(string, delimiters(0)) End Function ' ---------------------------------------------------------------------------- ' Main starts here ' ---------------------------------------------------------------------------- ' For timing of the search if (Timing = 1) then Dim StartTime, ElapsedTime StartTime = Timer end if 'Open and print start of result page template set fso = CreateObject("Scripting.FileSystemObject") set template = fso.OpenTextFile(Server.MapPath(TemplateFilename), 1) ' find the "" string in the template html file dim line, templateFile do while template.AtEndOfStream <> True line = template.ReadLine & VbCrLf templateFile = templateFile & line loop Template = split(templateFile, "") Response.Write(Template(0)) & VbCrLf ' Replace the key text with the following if (FormFormat > 0) then ' Insert the form Response.Write("
") & VbCrlf Response.Write("

Enter search word ") & VbCrlf Response.Write(" ") & VbCrlf if (FormFormat = 2) then Response.Write("Results per page:") & VbCrlf Response.Write("

") & VbCrlf 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 'Split search phrase into words query = Trim(query) 'for wildcards if WordSplit = 1 then SearchWords = SplitMulti(query, Array(" ", "-", "_", "[", "]", "+", """", "'")) else SearchWords = Split(query) end if ' Load the entire pages file into an array, all URL's on the site set pages_file = fso.OpenTextFile(Server.MapPath("zoom_pages.dat"), 1) urls = split(pages_file.ReadAll, chr(13) & chr(10)) ' Load the entire page titles file into an array set titles_file = fso.OpenTextFile(Server.MapPath("zoom_titles.dat"), 1) titles = split(titles_file.ReadAll, chr(13) & chr(10)) if OutputStyle = 1 then set desc_file = fso.OpenTextFile(Server.MapPath("zoom_descriptions.dat"), 1, False) descriptions = split(desc_file.ReadAll, chr(13) & chr(10)) end if 'Print heading Response.Write("

Search results for: """ & query & """

") & VbCrlf 'Open keywords file set fpkeywords = fso.OpenTextFile(Server.MapPath("zoom_keywords.dat"), 1, False) 'Loop through all search words numwords = UBound(SearchWords)+1 outputline = 0 dim output() 'default to use wildcards UseWildCards = 1 'Initialise regular expression object set regExp = New RegExp regExp.IgnoreCase = True regExp.Global = True for sw = 0 to numwords-1 ' check whether there are any wildcards used if (InStr(SearchWords(sw), "*") = False AND InStr(SearchWords(sw), "?") = False) then UseWildCards = 0 else ' new keword pattern to match for regExp.Pattern = pattern2regexp(SearchWords(sw)) UseWildCards = 1 end if 'Read in a line at a time from the keywords file do while fpkeywords.AtEndOfStream <> True line = fpkeywords.ReadLine data = Split(line, ",") if (UseWildCards = 0) then bMatched = Lcase(SearchWords(sw)) = Lcase(data(0)) else bMatched = regExp.Test(data(0)) end if if (bMatched = True) then 'Keyword found, so include it in the output list if (Highlighting = 1) then ' Add to matched words list if (IsInArray(data(0), matchwords) = False) then Redim preserve matchwords(matchwords_num) matchwords(matchwords_num) = data(0) matchwords_num = matchwords_num + 1 end if end if num = UBound(data) for kw = 1 to num Step 2 'Check if page is already in output list pageexists = 0 ipage = data(kw) for ol = 0 to outputline-1 if output(0, ol) = ipage then 'Page is already in output list, so add to count + extra if (output(1, ol) > 10000) then ' take it easy if its too big output(1, ol) = output(1, ol) + 1 else output(1, ol) = Int(output(1, ol)) + Int(data(kw+1)) 'Add in score output(1, ol) = output(1, ol) * 2 'Double score as we have two words matching end if output(2, ol) = Int(output(2, ol)) + 1 'Increase word match count pageexists = 1 end if next if pageexists = 0 then 'New page to add to list redim preserve output(3, outputline) output(0, outputline) = ipage 'Page index output(1, outputline) = Int(data((kw+1))) 'Score output(2, outputline) = 1 'Single word match only outputline = outputline + 1 end if next if (UseWildCards = False) then exit do end if end if loop 'Return to start of file - apparently only way to do this in ASP 'is close and re-open (according to msdn technet) fpkeywords.Close set fpkeywords = fso.OpenTextFile(Server.MapPath("zoom_keywords.dat"), 1, False) next 'Close the files used fpkeywords.Close pages_file.Close titles_file.Close if OutputStyle = 1 then desc_file.Close end if 'Get number of pages matched matches = outputline 'Count number of output lines that match ALL search terms 'and also remove results filtered by AND operation oline = 0 fullmatches = 0 do while ((oline < matches) AND numwords > 1) if output(2, oline) = numwords then fullmatches = fullmatches + 1 oline = oline + 1 elseif andq = 1 then 'AND search 'Remove the results filtered by AND 'by overwriting the last element, and then redim'ing lastelem = UBound(output, 2) output(0, oline) = output(0, lastelem) output(1, oline) = output(1, lastelem) output(2, oline) = output(2, lastelem) redim preserve output(3, lastelem - 1) matches = matches - 1 'note: we don't increment oline because we have to check lastelem else oline = oline + 1 end if loop if (andq = 1 AND numwords > 1) then matches = fullmatches end if ' Bubble sort the results if (matches > 0) then for i = UBound(output, 2)-1 To 0 Step -1 for j = 0 to i if output(1, j) < output(1, j+1) then 'Swap the two array elements temp = output(1, j+1) output(1, j+1) = output(1, j) output(1, j) = temp temp = output(2, j+1) output(2, j+1) = output(2, j) output(2, j) = temp temp = output(0, j+1) output(0, j+1) = output(0, j) output(0, j) = temp end if next next end if 'Display search results Response.Write("") if matches = 1 Then Response.Write("1 result found.") elseif matches = 0 Then Response.Write("No results found.") elseif numwords > 1 AND andq = 0 then SomeTermMatches = matches - fullmatches Response.Write("" & fullmatches & " results found containing all search terms. ") if (SomeTermMatches > 0) then Response.Write(SomeTermMatches & " results found containing some search terms.") end if Response.Write("") elseif numwords > 1 AND andq = 1 then Response.Write("" & fullmatches & " results found containing all search terms.") else Response.Write("" & matches & " results found.") end if Response.Write("
") & VbCrlf 'Number of pages of results ' Amazingly, there is no Ceiling function in VB prior to .NET ' Also note the way CInt rounds to nearest _whole_ number (0.5 -> 0, 1.5 -> 2) ' Hence this workaround if (matches MOD per_page = 0) then 'whole number num_pages = CInt(matches / per_page) else 'unwholey number num_pages = CInt((matches / per_page) + 0.5) end if 'num_pages = Math.Ceiling(cDbl(matches / per_page)) ' cInt rounds the number up if (num_pages > 1) then Response.Write("
" & num_pages & " pages of results.
") & VbCrlf end if ' Determine current line of result from the $output array if (page = 1) then arrayline = 0 else arrayline = (page - 1) * per_page end if ' The last result to show on this page result_limit = arrayline + per_page ' Display the results do while (arrayline < matches AND arrayline < result_limit) ipage = output(0, arrayline) score = output(1, arrayline) if (OutputStyle = 0) then 'Basic style Response.Write("

" & "Page: " & titles(ipage) & "
") & VbCrlf Response.Write("Score: " & score & "  URL:" & urls(ipage) & "

") & VbCrlf else 'Descriptive style Response.Write("

" & (arrayline+1) & ". " & titles(ipage) & "
") & VbCrlf if (Highlighting = 1) then PrintHighlightDescription(descriptions(ipage)) else Response.Write(descriptions(ipage)) end if Response.Write("...
") & VbCrlf Response.Write("Terms matched: " & output(2, arrayline) & " Score: " & score & "  URL: " & urls(ipage) & "

") & VbCrlf end if arrayline = arrayline + 1 loop 'Show links to other result pages if (num_pages > 1) then Response.Write("

Result Pages: ") if (page > 1) then Response.Write("<< Previous ") end if for i = 1 to num_pages if (CInt(i) = CInt(page)) then Response.Write(page & " ") else Response.Write("" & i & " ") end if next if (cInt(page) <> cInt(num_pages)) then Response.Write("Next >> ") end if end if ' Time the searching if (Timing = 1) then ElapsedTime = Timer - StartTime Response.Write("

Search took " & ElapsedTime & " seconds") end if 'Print out the end of the template call PrintEndOfTemplate 'Log the search words, if required if (Logging = 1) then LogString = FormatDateTime(Now) & ", " & Request.ServerVariables("REMOTE_ADDR") & ", """ & query & """, Matches = " & matches set logfile = fso.OpenTextFile(Server.MapPath(LogFileName), 8, true, 0) logfile.WriteLine(LogString) logfile.Close end if %>