The Ice Cavern's Search Oni

<% Option Explicit %> <% Response.Buffer = True 'Dimension global variables Dim fsoObject 'File system object Dim fldObject 'Folder object Dim sarySearchWord 'Array to hold the words to be searched for Dim strSearchWords 'Holds the search words Dim blnIsRoot 'Boolean set to true if it is the root dirctory Dim strFileURL 'Holds the path to the file on the site Dim strServerPath 'Holds the server path to this script Dim intNumFilesShown 'Holds the number of files shown so far Dim intTotalFilesSearched 'Holds the number of files searched Dim intTotalFilesFound 'Holds the total matching files found Dim intFileNum 'Holds the file number Dim intPageLinkLoopCounter 'Loop counter to display links to the other result pages Dim sarySearchResults(200) 'Array holding the search results Dim intDisplayResultsLoopCounter 'loop counter to diplay the results of the search Dim intResultsArrayPosition 'Stores the array position of the array storing the results Dim blnSearchResultsFound 'Set to true if search results are found Dim strFilesTypesToSearch 'Holds the types of files to be searched Dim strBarredFolders 'Holds the folders that you don't want searched Dim strBarredFiles 'Holds the names of the files not to be searched Dim blnEnglishLanguage 'Set to True if the user is using English Const intRecordsPerPage = 10 'results to show on each page strFilesTypesToSearch = "html,asp,shtml" 'types of files to parse strBarredFolders = "cgi-bin,bill" 'don't search these folders strBarredFiles = "index.shtml,search.asp,safeindex.shtml,nav.html,rebound.html" 'don't search these files blnEnglishLanguage = True 'True = English \ False = Other language 'Initalise variables intTotalFilesSearched = 0 %> The Ice Cavern's Search Oni

Site Search Oni

<% strSearchWords = Trim(Request.QueryString("search")) If blnEnglishLanguage = True Then 'If the site is in English then use the server HTML encode method 'Replace any HTML tags with the HTML codes for the same characters (stops people entering HTML tags) strSearchWords = Server.HTMLEncode(strSearchWords) Else 'If the site is not english just change the script tags 'Just replace the script tag <> with HTML encoded < and > strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1) strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1) End If sarySearchWord = Split(Trim(strSearchWords), " ") intFileNum = CInt(Request.QueryString("FileNumPosition")) intNumFilesShown = intFileNum Set fsoObject = Server.CreateObject("Scripting.FileSystemObject") If NOT Request.QueryString("search") = "" Then Set fldObject = fsoObject.GetFolder(Server.MapPath("./")) 'Get the path and the root folder to be searched strServerPath = fldObject.Path & "\"'Read in the server path to this ASP script blnIsRoot = True'Set to true as this is searching the root directory Call SearchFile(fldObject)'Call the search sub prcedure 'Reset server variables Set fsoObject = Nothing Set fldObject = Nothing 'Display the HTML table with the results status of the search or what type of search it is Response.Write vbCrLf & " " Response.Write vbCrLf & " " 'Display that there where no matching records found If blnSearchResultsFound = False Then Response.Write vbCrLf & " " Else 'Else Search went OK so display how many records found Response.Write vbCrLf & " " End If Response.Write vbCrLf & " " Response.Write vbCrLf & "

Searched the site for " & strSearchWords & ". Sorry, no results found.

Searched the site for " & strSearchWords & ". Displaying Results " & intFileNum + 1 & " - " & intNumFilesShown & " of " & intTotalFilesFound & ".

" 'HTML table to display the search results or an error if there are no results Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "

" If blnSearchResultsFound = False Then 'If no results are found then display an error message Response.Write vbCrLf & "
" Response.Write vbCrLf & " Your Search - " & strSearchWords & " - did not match any files on this site." Response.Write vbCrLf & "

" Response.Write vbCrLf & " Suggestions:" Response.Write vbCrLf & "
" Response.Write vbCrLf & "

Make sure all words are spelled correctly.
Try different keywords.
Try more general keywords.
Try fewer keywords.
Try browsing using the navigation bar.

" Else'Else display the results For intDisplayResultsLoopCounter = 1 to (intNumFilesShown - intFileNum) Response.Write vbCrLf & "
" Response.Write vbCrLf & " " & sarySearchResults(intDisplayResultsLoopCounter) Response.Write vbCrLf & "
" Next End If 'Close the HTML table displaying the results Response.Write vbCrLf & "

" End If 'Display an HTML table with links to the other search results If intTotalFilesFound > intRecordsPerPage then Response.Write vbCrLf & "
" Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "

" Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & " " Response.Write vbCrLf & "

" Response.Write vbCrLf & " Results Page: " 'If the page number is higher than page 1 then display a back link If intNumFilesShown > intRecordsPerPage Then Response.Write vbCrLf & " << Prev " End If 'If there are more pages to display then display links to all the search results pages If intTotalFilesFound > intRecordsPerPage Then For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5)'Loop to diplay a hyper-link to each page in the search results If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then 'If the page to be linked to is the page displayed then don't make it a hyper-link Response.Write vbCrLf & " " & intPageLinkLoopCounter Else Response.Write vbCrLf & " " & intPageLinkLoopCounter & " " End If Next End If 'If it is Not the last of the search results than display a next link If intTotalFilesFound > intNumFilesShown then Response.Write vbCrLf & " Next >>" End If 'Finsh HTML the table Response.Write vbCrLf & "

" Response.Write vbCrLf & "

" End If %>

Searched <% = intTotalFilesSearched %> documents in total.

<% Public Sub SearchFile(fldObject) 'Dimension local variabales Dim filObject 'File object Dim tsObject 'Text stream object Dim subFldObject 'Sub folder object Dim RegExpObject 'RegExp Object Dim strFileContents 'Holds the contents of the file being searched Dim strPageTitle 'Holds the title of the page Dim intTitleStartPositionInFile 'Holds the start postion in the file being searched of the title Dim intTitleEndPositionInFile 'Holds the end postion in the file being searched of the title Dim strPageDescription 'Holds the description of the page Dim intDescriptionStartPositionInFile 'Holds the start postion in the file being searched of the description Dim intDescriptionEndPositionInFile 'Holds the end postion in the file being searched of the description Dim intSearchLoopCounter 'Loop counter to search all the words in the array Dim blnSearchFound 'Set to true if the search words are found 'Error handler On Error Resume Next 'Loop to search each file in the folder For Each filObject in fldObject.Files If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then 'Check the file extension to make sure the file is of the extension type to be searched If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then 'Check to make sure the file about to be searched is not a barred file if it is don't search the file Set tsObject = filObject.OpenAsTextStream 'Open the file for searching strFileContents = tsObject.ReadAll 'Read in the contents of the file blnSearchFound = False 'Initalise the search found variable to flase If Request.QueryString("mode") = "phrase" Then If InStr(1, LCase(strFileContents), LCase(strSearchWords), 1) then blnSearchFound = True End If Else If Request.QueryString("mode") = "allwords" then blnSearchFound = True For intSearchLoopCounter = 0 to UBound(sarySearchWord) 'Loop round to search for each word to be searched If InStr(1, LCase(strFileContents), LCase(sarySearchWord(intSearchLoopCounter)), 1) Then If Request.QueryString("mode") = "anywords" then blnSearchFound = True Else If Request.QueryString("mode") = "allwords" then blnSearchFound = False End If Next End If intTotalFilesSearched = intTotalFilesSearched + 1 If blnSearchFound = True Then intTotalFilesFound = intTotalFilesFound + 1 If intNumFilesShown < (intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown Then 'Check that the file shown is between the the files shown so far and the maximum files to show per page intNumFilesShown = intNumFilesShown + 1 intTitleStartPositionInFile = InStr(1, lcase(strFileContents), "", 1) + 7 If NOT intTitleStartPositionInFile = 7 Then intTitleEndPositionInFile = InStr(intTitleStartPositionInFile, strFileContents, "", 1) strPageTitle = Server.HTMLEncode(Trim(Mid(strFileContents, intTitleStartPositionInFile, (intTitleEndPositionInFile - intTitleStartPositionInFile)))) Else strPageTitle = "No Title" End If 'Read in the description of the file intDescriptionStartPositionInFile = InStr(1, strFileContents, "", 1) strPageDescription = Server.HTMLEncode(Trim(Mid(strFileContents, intDescriptionStartPositionInFile, (intDescriptionEndPositionInFile - intDescriptionStartPositionInFile)))) Else strPageDescription = "There is no description available for this page" End If intResultsArrayPosition = intResultsArrayPosition + 1 blnSearchResultsFound = True If blnIsRoot = True Then sarySearchResults(intResultsArrayPosition) = "" & strPageTitle & "
" & vbCrLf & " " & strPageDescription Else sarySearchResults(intResultsArrayPosition) = "" & strPageTitle & "
" & vbCrLf & " " & strPageDescription End If End If End If tsObject.Close End If End If Next 'Loop to search through the sub folders within the site For Each subFldObject In FldObject.SubFolders If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then blnIsRoot = False strFileURL = fldObject.Path & "\" strFileURL = Replace(strFileURL, strServerPath, "") strFileURL = Replace(strFileURL, "\", "/") 'For NT servers strFileURL = Replace(strFileURL, " ", "%20") Call SearchFile(subFldObject) End If Next 'Reset server variables Set filObject = Nothing Set tsObject = Nothing Set subFldObject = Nothing End Sub %>