|
<%
' ----------------------------------------------------------------------------
' Zoom Search Engine 4.0 (10/3/2005)
' 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
Function MapPath(path)
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 fso = CreateObject("Scripting.FileSystemObject")
if (fso.FileExists(MapPath("settings.asp")) = False OR fso.FileExists(MapPath("zoom_wordmap.zdat")) = FALSE OR fso.FileExists(MapPath("zoom_dictionary.zdat")) = FALSE OR fso.FileExists(MapPath("zoom_pages.zdat")) = FALSE OR fso.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 '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(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(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(MapPath("zoom_cats.zdat")) = True) AND (fso.FileExists(MapPath("zoom_catpages.zdat")) = True) then
' Loads the entire categories page into an array
catnames = split(ReadDatFile(fso, "zoom_cats.zdat"), chr(10))
catpages = split(ReadDatFile(fso, "zoom_catpages.zdat"), 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
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(10))
' Load the entire page titles file into an array
titles = split(ReadDatFile(fso, "zoom_titles.zdat"), chr(10))
if (DisplayMetaDesc = 1) then
descriptions = split(ReadDatFile(fso, "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(fso, "zoom_datetime.zdat"), 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 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(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 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
' Strip slashes, sloshes, parenthesis and other regexp elements
query = Replace(query, "/", " ")
query = Replace(query, "\", " ")
query = Replace(query, "(", " ")
query = Replace(query, ")", " ")
query = Replace(query, "^", " ")
query = Replace(query, "[", " ")
query = Replace(query, "]", " ")
query = Replace(query, "|", " ")
query = Replace(query, "+", " ")
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(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(" ")
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(" ") & 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(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
end if ' Logging
end if ' NoSearch
'Print out the end of the template
call PrintEndOfTemplate
%> |
SEARCHING
TIPS: You can use this page to search our web site
for all documents containing matching words or patterns. You can use
an asterisk - "*" for a wild card, otherwise the result
will be searching for an exact match. You can use upper or lower case,
because case doesn't matter. You can use "and" to narrow
your search down.
|
|