<% Option Explicit %> <% 'Set the response buffer to true Response.Buffer = False 'Dimension global variables Dim fsoObject 'File system object Dim fldObject 'Folder object Dim sarySearchWord 'Array to hold words searched Dim strSearchWords 'Character string to hold search words Dim blnIsRoot 'Set to true if searching the root directory Dim strFileURL 'Stores path to file on the site Dim strServerPath 'Stores server path to search script Dim intNumFilesShown 'Stores number of initial files displayed Dim intTotalFilesSearched 'Stores number of files searched Dim intTotalFilesFound 'Stores total number of matching files found Dim intFileNum 'Stores file number Dim intPageLinkLoopCounter 'Loop counter displays links to other result pages Dim sarySearchResults(1000,2) 'Two-dimensional array that holds the search results Dim intDisplayResultsLoopCounter 'Loop counter which diplays search results Dim intResultsArrayPosition 'Stores position of the array that stores the results Dim blnSearchResultsFound 'If search results found, set True Dim strFilesTypesToSearch 'Stores file types searched Dim strBarredFolders 'Stores folders excluded from search Dim strBarredFiles 'Stores file names excluded from search Dim blnEnglishLanguage 'If English user, set True 'Number of results to display on each page Const intRecordsPerPage = 10 'change this to the number of results to show on each page 'File types to search, comma delineated strFilesTypesToSearch = "htm,html,asp,shtml" 'Excluded folders, comma delineated strBarredFolders = "cgi_bin,_bin,assets,Content,Library,logs,private" 'cgi_bin and _bin have been put in here as examples, but you can put any folders in here 'Excluded files (include file extension), comma delineated strBarredFiles = "search.asp,wedc.css,iframe.css,fill.gif,cm_fill.gif,wedc_intro.swf,menu.js," 'Set to False if non-English web site blnEnglishLanguage = True 'True = HTML Encode for English sites \ False = no Emcoding for non English sites 'Initalize variables intTotalFilesSearched = 0 %> City of Waller - Search Search WallerEDC.org
The City of Waller
 

Click for detailed map
 

  Print this page        

Search Waller City Web Site

Search the Web Site:
">

Search On : All Words Any Words Phrase
<% 'Read in all search words as one variable strSearchWords = Trim(Request.QueryString("search")) 'For English sites - use server HTML encoding If blnEnglishLanguage = True Then 'Replace any HTML tags with the HTML codes for the same characters (stops people entering HTML tags) strSearchWords = Server.HTMLEncode(strSearchWords) 'For non-English sites modify script Else 'Just replace the script tag <> with HTML encoded < and > strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1) strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1) End If 'Character split of each word searched and storage into the array sarySearchWord = Split(Trim(strSearchWords), " ") 'Read file number position to display intFileNum = CInt(Request.QueryString("FileNumPosition")) 'Set number of files shown to file number read position (line 128) intNumFilesShown = intFileNum 'Create File System object Set fsoObject = Server.CreateObject("Scripting.FileSystemObject") 'For no words entered null out search routine If NOT strSearchWords = "" Then 'Get path and root folder to be searched Set fldObject = fsoObject.GetFolder(Server.MapPath("./")) 'Read in server path to search.asp strServerPath = fldObject.Path & "\" 'Set to true - searching root directory blnIsRoot = True 'Search sub procedure call Call SearchFile(fldObject) 'Flush server variables Set fsoObject = Nothing Set fldObject = Nothing 'Bubble Sort procedure call sorts results by highest relevancy first Call SortResultsByNumMatches(sarySearchResults, intTotalFilesFound) 'Results status of search or type of search displayed in HTML table Response.Write vbCrLf & " " Response.Write vbCrLf & " " 'No matching records found display If blnSearchResultsFound = False Then Response.Write vbCrLf & " " 'Number of records found display Else Response.Write vbCrLf & " " End If 'Close the HTML table with the search status 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 no results are found then display an error message If blnSearchResultsFound = False Then 'Write HTML displaying the error Response.Write vbCrLf & "
" Response.Write vbCrLf & " Your search - " & strSearchWords & " - no matches found on WallerEDC.org" Response.Write vbCrLf & "

" Response.Write vbCrLf & " Suggestions:" Response.Write vbCrLf & "
" Response.Write vbCrLf & "
  • Check spelling of keyword(s).
  • Use other keyword(s).
  • Use less specific keywords.
  • Use fewer keywords.
" 'Else display the results Else 'Loop to display each result within the search results array For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown Response.Write vbCrLf & "
" Response.Write vbCrLf & " " & sarySearchResults(intDisplayResultsLoopCounter,1) 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 'Display an HTML table with links to the other search results 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 page count higher than one - display a back hyperlink If intNumFilesShown > intRecordsPerPage Then Response.Write vbCrLf & " << Prev " End If 'Links display if additional pages exist for all the search results If intTotalFilesFound > intRecordsPerPage Then 'Loop for hyperlink to each page of search results For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5) 'Truncate hyperlinks if only one page of search results exists If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then Response.Write vbCrLf & " " & intPageLinkLoopCounter Else Response.Write vbCrLf & "  " & intPageLinkLoopCounter & "  " End If Next End If 'Displays "Next" hyperlink if not the last search results page If intTotalFilesFound > intNumFilesShown then Response.Write vbCrLf & "  Next >>" End If 'End writing the HTML table Response.Write vbCrLf & "
" Response.Write vbCrLf & "
" End If %>

 Searched <% = intTotalFilesSearched %> documents in total.

 

Legal Disclamers

|

Vision Statement

|

Directions

|

Contact Info

Site Design by MTS
 
 © 2007-2009 City of Waller, Texas
1118 Farr St - Waller - Texas - 77484
Tel (936) 931-1042
<% 'Search sub-procedure Public Sub SearchFile(fldObject) 'Dimension local variabales Dim objRegExp 'Regular expression object Dim objMatches 'Stores matched collection of regular expression object Dim filObject 'File object Dim tsObject 'Text stream object Dim subFldObject 'Sub folder object Dim strFileContents 'Stores file contents Dim strPageTitle 'Stores page title Dim strPageDescription 'Stores page description Dim strPageKeywords 'Stores page keywords Dim intSearchLoopCounter 'Loop through array to count all search words Dim intNumMatches 'Stores number of matched words Dim blnSearchFound 'Set true if search words are found 'Error handler On Error Resume Next 'Set the error object to 0 Err.Number = 0 'Create the Regular Expressions object Set objRegExp = New RegExp 'Regular Expressions not supported will trap error If Err.Number <> 0 Then Response.Write("
Error! This server does not support the Regular Expessions object") 'Reset error object Err.Number = 0 End If 'Search all folder files loop For Each filObject in fldObject.Files 'Validate file extensions If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then 'Validate excluded files If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then 'Initalize search found variable - false blnSearchFound = False 'Initalize number of matches variable intNumMatches = 0 'Set Regular Expression object to itterate though all occurances of searched word objRegExp.Global = True 'Set Regular Expression object to ignore case objRegExp.IgnoreCase = True 'Open file to search Set tsObject = filObject.OpenAsTextStream 'Read contents of file strFileContents = tsObject.ReadAll 'Read title of file strPageTitle = GetFileMetaTag("", "", strFileContents) 'Read description meta tag of file strPageDescription = GetFileMetaTag("", strFileContents) 'Read keywords of file strPageKeywords = GetFileMetaTag("", strFileContents) 'Set Regular Expressions object pattern to remove HTML tags objRegExp.Pattern = "<[^>]*>" 'Remove HTML tags from file contents searched strFileContents = objRegExp.Replace(strFileContents,"") 'Reinsert title, description and meta keywords into searched file strFileContents = strFileContents & " " & strPageTitle & " " & strPageDescription & " " & strPageKeywords 'Search by phrase loop If Request.QueryString("mode") = "phrase" Then 'Set search pattern objRegExp.Pattern = "\b" & strSearchWords & "\b" 'Search for phrase in file Set objMatches = objRegExp.Execute(strFileContents) 'Validate if phrase exists If objMatches.Count > 0 Then 'Retrieve phrase matches intNumMatches = objMatches.Count 'If search input found - set search found variable True blnSearchFound = True End If 'Search is by All or Any words Else 'If the search is by all words then initialise the search found variable to true If Request.QueryString("mode") = "allwords" then blnSearchFound = True 'Search loop for each word searched For intSearchLoopCounter = 0 to UBound(sarySearchWord) 'Set Regular Expressions object search pattern objRegExp.Pattern = "\b" & sarySearchWord(intSearchLoopCounter) & "\b" 'Search file for the search words Set objMatches = objRegExp.Execute(strFileContents) 'Validate found words If objMatches.Count > 0 Then 'Count number of times search word matched intNumMatches = intNumMatches + objMatches.Count 'For Any word search - if search word is found then set search found variable True If Request.QueryString("mode") = "anywords" then blnSearchFound = True Else 'For All word search - if search word is not found then set search found variable False If Request.QueryString("mode") = "allwords" then blnSearchFound = False End If Next End If 'Sum total files searched intTotalFilesSearched = intTotalFilesSearched + 1 'For no title, Page Title variable displayed If strPageTitle = "" Then strPageTitle = "No Title" 'For no description, Page Description variable displayed If strPageDescription = "" Then strPageDescription = "There is no description available for this page" 'Display results if search found variable True If blnSearchFound = True Then 'Sum total files found intTotalFilesFound = intTotalFilesFound + 1 'Validate file shown within maximum files displayed parameters (line 29) If intNumFilesShown < (intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown Then 'Sum number of results intNumFilesShown = intNumFilesShown + 1 End If 'Store search results in Results Array and sum array position intResultsArrayPosition = intResultsArrayPosition + 1 'Set search results boolean True blnSearchResultsFound = True 'If file in the root directory If blnIsRoot = True Then 'Save search results in Results Array sarySearchResults(intResultsArrayPosition,1) = "" & strPageTitle & "" 'If file is_not_in the root directiory Else 'Save search results in Results Array sarySearchResults(intResultsArrayPosition,1) = "" & strPageTitle & "" End If 'Save remaining search results in Results Array sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "
" & strPageDescription sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "
Search Matches " & intNumMatches & "  -  Last Updated " & FormatDateTime(filObject.DateLastModified, VbLongDate) & "  -  Size " & CInt(filObject.Size / 1024) & "kb" 'Read number of search word matches into second specifier of the two dimensional array sarySearchResults(intResultsArrayPosition,2) = intNumMatches End If 'Close Text Stream object tsObject.Close End If End If Next 'Flush Regular Expression object Set objRegExp = Nothing 'Site sub folder search loop For Each subFldObject In FldObject.SubFolders 'Validate search folder is not excluded folder and skip folder if it is excluded If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then 'Searching sub directories - set False blnIsRoot = False 'Get server path for file strFileURL = fldObject.Path & "\" 'Replace server path of file with URL path strFileURL = Replace(strFileURL, strServerPath, "") 'Replace NT backslash with the forward slash for URL strFileURL = Replace(strFileURL, "\", "/") 'URL encoding of file name and path strFileURL = Server.URLEncode(strFileURL) 'Replaces encoded backslashes strFileURL = Replace(strFileURL, "%2F", "/") 'Search sub prcedure call to search entire web site Call SearchFile(subFldObject) End If Next 'Flush server variables Set filObject = Nothing Set tsObject = Nothing Set subFldObject = Nothing End Sub 'Bubble Sort sub procedure to sort array - highest relevent matches first Private Sub SortResultsByNumMatches(ByRef sarySearchResults, ByRef intTotalFilesFound) 'Dim variables Dim intArrayGap 'Stores part of array being sorted Dim intIndexPosition 'Stores the Array index position being sorted Dim intTempResultsHold 'Temporary store for results if swapping array positions Dim intTempNumMatchesHold 'Temporary store for number of matches for the results if swapping array positions Dim intPassNumber 'Stores pass number for sort 'Sort results loop For intPassNumber = 1 To intTotalFilesFound 'Truncate number of passes For intIndexPosition = 1 To (intTotalFilesFound - intPassNumber) 'If result sorted contains less matches than next result in array then swap position If sarySearchResults(intIndexPosition,2) < sarySearchResults((intIndexPosition+1),2) Then 'Store result sorted in temporary variable intTempResultsHold = sarySearchResults(intIndexPosition,1) 'Store number of matches for the result being sorted in a temporary variable intTempNumMatchesHold = sarySearchResults(intIndexPosition,2) 'Array position swap - move next result with higher relevancy to current array location sarySearchResults(intIndexPosition,1) = sarySearchResults((intIndexPosition+1),1) 'Move the next match integer for the result with a higher relevancy to current array location sarySearchResults(intIndexPosition,2) = sarySearchResults((intIndexPosition+1),2) 'Move result from temporary storage variable into next array position sarySearchResults((intIndexPosition+1),1) = intTempResultsHold 'Move number of result matches from temporary storage variable into next array position sarySearchResults((intIndexPosition+1),2) = intTempNumMatchesHold End If Next Next End Sub 'File meta tag function Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents) 'Dim variables Dim intStartPositionInFile 'Stores start position in file Dim intEndPositionInFile 'Stores end position in file 'Gets start position in file of meta tag intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1) 'For no description or keywords with name=, handles use of http-equiv= in meta tags If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then 'Swap meta tags strStartValue = Replace(strStartValue, "name=", "http-equiv=") 'Step through HTML for keywords or description intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1) End If 'If description exists, position in file >0 If NOT intStartPositionInFile = 0 Then 'Get HTML meta tag end position intStartPositionInFile = intStartPositionInFile + Len(strStartValue) 'Get HTML meta tag closing tag position intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1) 'Read meta tag info from file for function return GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile))) 'If no meta tag then GetFileMetaTag function returns null Else GetFileMetaTag = "" End If End Function %>