<%@LANGUAGE=VBSCRIPT%> <% option explicit on error resume next %> <% '***************************** CONFIGURATION AREA ****************************** 'DEFINE YOUR CATALOG... 'use "query://192.168.0.1/catalogname" for strCatalog replacing the IP address and catalog name 'as appropriate. Dim strCatalog 'strCatalog = "query://indexvws1.magma.ca/VWSID.VWSNAME" 'change this value to suit your catalog name! strCatalog = "query://10.0.20.43/." 'SET THE NUMBER OF RESULTS TO SHOW ON THE PAGE... Dim intResultsPerPage intResultsPerPage = 10 'modify this value to change the number of results on each page. 'MASKING OUT FILE TYPES, FILES AND DIRECTORIES... Dim strQuery strQuery = Trim(Request.Querystring("QU")) 'Do not modify this value. ' mask out unwanted document types. You can add to this list if necessary (note: I find that word document templates .DOT screw up the index so try and avoid indexing these filetypes). strQuery = strQuery & " and not #filename *.|(txt|,inc|,dot|,mdb|,cgi|,class|,toc|,csv|,css|,dwg|,dwf|,vbs|,cdx|,png|,asp|)" ' mask out specific files (repeat the line below for other files). strQuery = strQuery & " and not #filename password.txt" ' mask out unwanted directories here, such as the FrontPage vti_ (repeat the line below for other directories) strQuery = strQuery & " and not #path *\_vti*" 'OTHER OPTIONS... Dim strShowAbstract strShowAbstract = True 'set False if you want to hide abstracts. Dim bHighlightResults bHighlightResults = False 'set True if you want to highlight search keywords in Abstracts. Dim strShowHelp strShowHelp = False 'set False if you want to hide the search help. Dim intMaxRecords intMaxRecords = 300 'set the maximum number of records to return for any given search. Dim strTargetFrame strTargetFrame = "_self" 'set the target frame for document links to open in. '******************************************************************************* ' DO NOT MODIFY BENEATH THIS LINE! '******************************************************************************* Dim Page If Request.QueryString("PAGE") = "" then Page = 1 Else Page = Request.QueryString("PAGE") End If Dim REAL_SERVER_NAME Function getURL(vpath,path) 'This function generates the document links by checking the vpath variable, processing 'the path variable against the root of the site or simply using the path in its raw form. 'This is the best way to ensure that the correct links are returned for the widest variety 'of Indexing Service configurations. Dim strProtocol IF Trim(LCase(Request.ServerVariables("HTTPS"))) = "on" THEN strProtocol = "https://" ELSE strProtocol = "http://" END IF Dim strPort IF Request.ServerVariables("SERVER_PORT") = "80" OR Request.ServerVariables("SERVER_PORT") = "443" Then strPort = "" Else strPort = ":" & Request.ServerVariables("SERVER_PORT") End If Dim strPhysicalPath strPhysicalPath = Left(Request.ServerVariables("PATH_TRANSLATED"),(Len(Request.ServerVariables("PATH_TRANSLATED"))-Len(Request.ServerVariables("PATH_INFO")))) 'We need to strip the last 22 characters from the "SERVER_NAME" environment variable (.asp.internal.magma.ca) REAL_SERVER_NAME = Left(Request.ServerVariables("SERVER_NAME"),(Len(Request.ServerVariables("SERVER_NAME"))-22)) IF vpath = "" OR isNULL(vpath) THEN IF inStr(LCase(path),LCase(strPhysicalPath)) THEN getURL = strProtocol & REAL_SERVER_NAME & strPort & Replace(Replace(LCase(path),LCase(strPhysicalPath),""),"\","/") ELSE getURL = path END IF ELSE getURL = strProtocol & REAL_SERVER_NAME & strPort & vpath END IF End Function Function getTitle(doctitle,filename) 'This simple function will return the Document Title if available. If not, it will return 'the File Name instead. IF Trim(doctitle) = "" OR isNULL(doctitle) THEN getTitle = Server.HTMLEncode(filename) ELSE getTitle = Server.HTMLEncode(doctitle) END IF End Function Function getHighlight(string) IF bHighLightResults = True THEN Dim strHighlight strHighlight = Request.QueryString("QU") Dim processQuery set processQuery = New RegExp processQuery.IgnoreCase = True processQuery.Global = True processQuery.Pattern = CHR(34) & ".*?" & CHR(34) Dim processMatches Set processMatches = processQuery.Execute(strHighlight) Dim Match FOR each Match in processMatches strHighlight = Replace(strHighlight,match.value,Replace(match.value," ","+"),1,1) NEXT Set processMatches = nothing Set processQuery = nothing Dim arrString arrString = Split(Replace(LCase(strHighlight),CHR(34),"")," ") Dim arrFinalString() Dim j j = 0 Dim i FOR i = 0 to UBOUND(arrString) arrString(i) = Replace(arrString(i),CHR(34),"") arrString(i) = Replace(arrString(i),"(","") arrString(i) = Replace(arrString(i),")","") arrString(i) = Replace(arrString(i),"+"," ") IF LCase(Trim(arrString(i))) = "and" THEN ELSEIF LCase(Trim(arrString(i))) = "or" THEN ELSEIF LCase(Trim(arrString(i))) = "near" THEN ELSEIF LCase(Trim(arrString(i))) = "span" THEN ELSEIF LCase(Trim(arrString(i))) = "class" THEN ELSEIF LCase(Trim(arrString(i))) = "span*" THEN ELSEIF LCase(Trim(arrString(i))) = "class*" THEN ELSEIF LCase(Trim(arrString(i))) = "" THEN ELSEIF LCase(Trim(arrString(i))) = ">" THEN ELSEIF LCase(Trim(arrString(i))) = "<" THEN ELSEIF LCase(Trim(arrString(i))) = "=" THEN ELSEIF Left(arrString(i),1) = "@" THEN ELSEIF Left(arrString(i),1) = "#" THEN ELSEIF Left(arrString(i),1) = "*" THEN ELSE ReDim Preserve arrFinalString(j) arrFinalString(j) = arrString(i) j = j + 1 END IF Next Dim regex Set RegEx = New RegExp For i = 0 to UBOUND(arrFinalString) IF Right(arrFinalString(i),1) = "*" THEN arrFinalString(i) = Left(arrFinalString(i),Len(arrFinalString(i))-1) RegEx.Pattern = "\b" & arrFinalString(i) ELSE RegEx.Pattern = "\b" & arrFinalString(i) & "\b" END IF RegEx.Global = True RegEx.IgnoreCase = True string = RegEx.Replace(string, "" & arrFinalString(i) & "") Next End If getHighlight = string End Function Function getAbstract(abstract) 'This function will format and return the Characterisation (Abstract) if strShowAbstract 'is set to True (see Configuration area above). IF strShowAbstract = False THEN getAbstract = "" ELSE IF abstract = "" OR isNULL(abstract) THEN getAbstract = "Abstract: [No Abstract available for this document]
" ELSE getAbstract = "Abstract: " & getHighlight(Server.HTMLEncode(abstract)) & "...
" END IF END IF End Function Function getRank(rank) 'This function coverts the 4 digit Rank to a Percentage. All values under 1% are 'treated as 1%. Dim intRank intRank = rank/10 IF intRank < 1 THEN intRank = 1 ELSE intRank = FormatNumber(intRank,0) END IF getRank = intRank & "%" End Function Function getSize(filesize) 'This function converts and formats the filesize in Bytes to either Bytes, KB or MB 'as appropriate. Dim intFileSize intFileSize = Trim(filesize) IF intFilesize > 1048575 THEN getSize = FormatNumber(intFilesize/1048576,0) & " MB" ELSEIF intFilesize > 1023 AND intFilesize < 1048576 THEN getSize = FormatNumber(intFilesize/1024,1) & " KB" ELSE getSize = intFilesize & " Bytes" END IF End Function Function getWrite(write) 'This simple function formats the last modified date into long-form date and time. getWrite = FormatDateTime(write,1) & " at " & FormatDateTime(write,3) End Function Function getLinks(TotalPages,CurrentPage) 'This function creates the page links and also parses the current QueryString enabling 'additional Form variables to be used without the need to modify code. Dim strQueryString Dim item for each item in Request.QueryString() IF item <> "PAGE" THEN strQueryString = strQueryString & item & "=" & Server.URLEncode(Request.QueryString(item)) & "&" END IF next IF Right(strQueryString,1) = "&" THEN strQueryString = Left(strQueryString,Len(strQueryString)-1) END IF Dim strLinks strLinks = "

" & VbCrLf IF CInt(Request.QueryString("PAGE")) > 1 THEN strLinks = strLinks & " Prev" & VbCrLf END IF Dim i i = 1 Do IF i = CInt(CurrentPage) THEN strLinks = strLinks & " " & i & " " & VbCrLf ELSE strLinks = strLinks & " " & i & " " & VbCrLf END IF i = i + 1 Loop While i <= TotalPages ' Display the Next button unless we are on the last page... if CInt(CurrentPage) < CInt(TotalPages) then strLinks = strLinks & " Next" & VbCrLf End If strLinks = strLinks & "

" & VbCrLf getLinks = strLinks End Function Function nomatches(message) 'This function returns information for all searches that do not generate results. 'These include, New Searches, No Results and all Error handling. Dim objFSO, objText, strHelpContents Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objText = objFSO.OpenTextFile(Server.MapPath("help.htm")) IF NOT(strShowHelp = False) THEN strHelpContents = objText.ReadAll ELSE strHelpContents = "" END IF Dim strMessage strMessage = strMessage & message & strHelpContents & VbCrLf & getFooter Response.Write(strMessage) END Function Function getError(error) Dim strError If Trim(LCase(error)) = "unexpected not operator." & VbCrLf THEN strError = "Unexpected NOT operator. Please use AND NOT for NOT searches." ElseIf Trim(LCase(error)) = "expecting phrase." & VbCrLf THEN strError = "Your search query " & Request.QueryString("QU") & " was not understood." Else strError = error End If getError = strError End Function Function getFooter() 'This function simply displays the search Footer. getFooter = "

Powered by Microsoft Index Server

" End Function Sub doSearch(query) 'This Sub carries out the search and generates the results recordset. IF Request.QueryString("Action") = "Search" THEN 'form has been submitted. IF (Trim(Request.QueryString("QU")) = "" OR isNULL(Request.QueryString("QU"))) AND Request.QueryString("Action") = "Search" THEN 'Search box is empty or contains only spaces. nomatches("

Nothing to Search for!
Please enter your search query in the box above...

") ELSE 'Search box contains a query. Dim Index Set Index = Server.CreateObject("IXSSO.Query") Index.catalog = strCatalog Index.Query = query Index.CiScope = "\" Index.Columns = "HitCount, filename, Vpath, DocTitle, characterization, rank, size, path, write" Index.SortBy = "rank[d]" Index.MaxRecords = intMaxRecords Index.Dialect = 2 Dim Results Set Results = Index.CreateRecordset("nonsequential") IF NOT Results.EOF THEN 'The query produced some results. Results.MoveFirst Results.PageSize = intResultsPerPage Results.AbsolutePage = Page Dim intTotalPages intTotalPages = Results.PageCount Dim strRefine IF results.Recordcount = intMaxRecords THEN 'The maximum number of results have been returned. Tell the user they might want to be more specific. strRefine = "You may want to refine your search." ELSE strRefine = "" END IF strResults = "Your Search for " & Request.Querystring("QU") & " matched " & results.recordcount & " Documents (Page " & Page & " of " & intTotalPages & ").
" & strRefine & "" & VbCrLf Dim intNumber intNumber = 1 + page * intresultsPerPage - intresultsPerPage Dim intCounter intCounter = 0 Dim strResults strResults = strResults & "
    " & VbCrLf Do While Not results.EOF AND intCounter < results.PageSize 'Begin rendering results as a HTML ordered list (OL). strResults = strResults & "
  1. " & VbCrLf strResults = strResults & " " & getTitle(results("DocTitle"),results("FileName")) & " (" & getRank(results("Rank")) & ")
    " & VbCrLf strResults = strResults & " " & getAbstract(results("characterization")) & VbCrLf strResults = strResults & " " & getURL(results("Vpath"),results("path")) & "
    " & VbCrLf strResults = strResults & " File Name: " & results("filename") & ", Size: " & getSize(results("size")) & ", Last Modified: " & getWrite(results("write")) & "

    " & VbCrLf strResults = strResults & "
    2. " & VbCrLf intNumber = intNumber + 1 intCounter = intCounter + 1 results.MoveNext Loop results.Close Set results = nothing strResults = strResults & "
" & VbCrLf strResults = strResults & getLinks(intTotalPages,Page) strResults = strResults & getFooter Response.Write(strResults) ELSE 'no results were found. nomatches("

Your Search for " & Request.Querystring("QU") & " matched no Documents.
Please check your spelling or search using more general keywords.

") END IF END IF ELSE 'this is a new search nomatches("

Please enter your search query in the box above...

") END IF End Sub %> Search

Site Search

" method="GET"> " class="searchinput">
<% 'this script section calls the search results doSearch(strQuery) If Err.number <> 0 then nomatches("

ERROR: " & GetError(Err.Description) & "
Please try again...

") End If %>