<% Response.Buffer = True Dim lIndexErrorNum, sIndexError Dim sSearchResults(750,2) Dim sWebsitePath, mNumResults, bMatchesMade, sSearchTerms, sSearchInSection, sSearchOnWhat sSearchTerms = Trim(Request.QueryString("ferretthis")) sSearchInSection = Trim(Request.QueryString("where")) sSearchOnWhat = Request.QueryString("onwhat") sWebsitePath = Server.MapPath("/") mNumResults = 0 bMatchesMade = False %> <%= cssStyle %>

Website Search
Search For:	Search In:
" class=title1>	Entire Website<% Call Return_Mappings() %>
All Words Any Words Phrase
Search Help | Power Search
<% Dim ltimestart, ltimeend ltimestart = Timer If sSearchTerms <> "" Then If sSearchInSection = "" Or sSearchInSection = "0" Then Call Process_Dirs("",1) Else Call Process_Dirs(sSearchInSection,2) End If If bMatchesMade Then Call Shell_Sort(sSearchResults) Call Show_Results() Else Response.Write ResultHead_HTML(sSearchTerms,0,-1,-1) Response.Write ResultFoot_HTML("Sorry, no results were found matching your search. To get the best possible search results, try the following tips: Check spelling - Make sure your search terms are spelled correctly. The search engine will attempt to find words that sound similar to your search terms, but it is always best to spell the search terms correctly. Use multiple words - Use multiple words when performing your search. Using more words will return more refined results than searching for a single word. Use similar words - The more similar words you use in a search, the more relevant your results will be. ") End If Else Response.Write ResultHead_HTML(sSearchTerms,0,-1,-1) Response.Write ResultFoot_HTML("Please enter your search terms in the search box above and click 'Go'.") End If ltimeend = Timer %> Search Help | Power Search Results found in <%= Round(ltimeend-ltimestart,2) %> seconds.

<% Sub Shell_Sort(ByRef iArray) Dim i, j, iLBound, iUBound Dim iMax, iTemp, sTemp, distance Dim SortOrder, bSortOrder SortOrder = 1 'asc=0,desc=1 iLBound = LBound(iArray) iUBound = mNumResults bSortOrder = IIf(SortOrder = 0, False, True) iMax = iUBound - iLBound + 1 Do distance = distance * 3 + 1 Loop Until distance > iMax Do distance = distance \ 3 For i = distance + iLBound To iUBound iTemp = iArray(i,2) sTemp = iArray(i,1) j = i Do While (iArray(j - distance,2) > iTemp) Xor bSortOrder iArray(j,2) = iArray(j - distance,2) iArray(j,1) = iArray(j - distance,1) j = j - distance If j - distance < iLBound Then Exit Do Loop iArray(j,2) = iTemp iArray(j,1) = sTemp Next Loop Until distance = 1 End Sub 'end of proc Shell_Sort Sub Return_Mappings() Dim sArray,i sArray = Split(sDirMappings,",") For i = 0 To Ubound(sArray) -1 If Not IsOdd(i) Then Response.Write "" & sArray(i + 1) & "" End If Next End Sub Function IIf(psdStr, trueStr, falseStr) If psdStr Then IIf = trueStr Else IIf = falseStr End If End Function 'end of func IIf Sub Search_File(paramFile) Dim objRegExp, objMatches, sSearchFor, sFileContents Dim sTmp, sPattern, sURL, sDesc, sTitle, i sSearchFor = Trim(sSearchTerms) sFileContents = Get_FileContents(paramFile) Set objRegExp = New RegExp objRegExp.Global = True objRegExp.IgnoreCase = True Select Case Request.QueryString("andor") Case "phrase" sPattern = "\b" & sSearchFor & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sFileContents) Case "anywords" sTmp = Split(sSearchFor," ") If UBound(sTmp) = 0 Then sPattern = "\b" & sSearchFor & "\b" Else sPattern = "(\b" & Trim(sTmp(0)) & "\b)" For i = 1 To UBound(sTmp) sPattern = sPattern & "|(\b" & Trim(sTmp(i)) & "\b)" Next End If objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sFileContents) Case Else sTmp = Split(sSearchFor," ") If UBound(sTmp) = 0 Then sPattern = "\b" & sSearchFor & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sFileContents) Else sPattern = "\b" & Trim(sTmp(0)) & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sFileContents) For i = 1 To UBound(sTmp) If objMatches.Count > 0 Then sPattern = "\b" & Trim(sTmp(i)) & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sFileContents) End If Next End If End Select If objMatches.Count > 0 Then sURL = Replace(paramFile.Path, sWebsitePath, "", 1, -1, 1) sURL = Replace(sURL, "\", "/") '" sTitle = Extract_MetaTag("title", sFileContents) sDesc = Extract_MetaTag ("description", sFileContents) sSearchResults(mNumResults,1) = sURL & "<|>" & sTitle & "<|> " & sDesc & "<|>" _ & CInt(paramFile.Size / 1024) & "<|>" & paramFile.Name & "<|>" _ & paramFile.DateLastModified sSearchResults(mNumResults,2) = objMatches.Count mNumResults = mNumResults + 1 bMatchesMade = True End If Set objMatches = Nothing Set objRegExp = Nothing End Sub 'end of proc Search_File Sub Search_Part(paramFile) Dim objRegExp, objMatches, sSearchFor, sFileContents, sSearchThis Dim sTmp, sPattern, sURL, sDesc, sTitle, i sSearchFor = Trim(sSearchTerms) sFileContents = Get_FileContents(paramFile) sTitle = Extract_MetaTag("title", sFileContents) sDesc = Extract_MetaTag ("description", sFileContents) Select Case sSearchOnWhat Case "url" sSearchThis = "" Case "titles" sSearchThis = sTitle Case "keywords" sSearchThis = Extract_MetaTag ("keywords", sFileContents) Case "desc" sSearchThis = sDesc End Select Set objRegExp = New RegExp objRegExp.Global = True objRegExp.IgnoreCase = True Select Case Request.QueryString("andor") Case "phrase" sPattern = "\b" & sSearchFor & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sSearchThis) Case "anywords" sTmp = Split(sSearchFor," ") If UBound(sTmp) = 0 Then sPattern = "\b" & sSearchFor & "\b" Else sPattern = "(\b" & Trim(sTmp(0)) & "\b)" For i = 1 To UBound(sTmp) sPattern = sPattern & "|(\b" & Trim(sTmp(i)) & "\b)" Next End If objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sSearchThis) Case Else sTmp = Split(sSearchFor," ") If UBound(sTmp) = 0 Then sPattern = "\b" & sSearchFor & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sSearchThis) Else sPattern = "\b" & Trim(sTmp(0)) & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sSearchThis) For i = 1 To UBound(sTmp) If objMatches.Count > 0 Then sPattern = "\b" & Trim(sTmp(i)) & "\b" objRegExp.Pattern = sPattern Set objMatches = objRegExp.Execute(sSearchThis) End If Next End If End Select If objMatches.Count > 0 Then sURL = Replace(paramFile.Path, sWebsitePath, "", 1, -1, 1) sURL = Replace(sURL, "\", "/") '" sSearchResults(mNumResults,1) = sURL & "<|>" & sTitle & "<|> " & sDesc & "<|>" _ & CInt(paramFile.Size / 1024) & "<|>" & paramFile.Name & "<|>" _ & paramFile.DateLastModified sSearchResults(mNumResults,2) = objMatches.Count mNumResults = mNumResults + 1 bMatchesMade = True End If Set objMatches = Nothing Set objRegExp = Nothing End Sub Sub Process_Dirs(sFolder,mGo) Dim objFSO, objFld, objSubFld, objSubFldList Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Select Case mGo Case 1 Set objFld = objFSO.GetFolder(Server.MapPath("/")) Call Process_Files(objFSO, objFld) Case 2 Set objFld = objFSO.GetFolder(sFolder) Call Process_Files(objFSO, objFld) Case 3 Set objFld = objFSO.GetFolder(sFolder) End Select For Each objSubFld In objFld.Subfolders If Not InStr(1, sDisallowDir, objSubFld.Path & ",", vbTextCompare) > 0 Then Call Process_Files(objFSO, objSubFld) Set objSubFldList = objSubFld.SubFolders If objSubFldList.Count > 0 Then Call Process_Dirs(objSubFld.Path,3) End If End If Next Set objSubFldList = Nothing Set objSubFld = Nothing Set objFld = Nothing Set objFSO = Nothing End Sub 'end of proc Process_Dirs Function IsOdd(byVal hInput) If InStr(hInput, ".") <> 0 Then hInput = Left(hInput, InStrRev(hInput, ".") - 1) If Not IsNumeric(hInput) Then IsOdd = Null: Exit Function IsOdd = CBool( hInput Mod 2 ) End Function Sub Process_Files(objFileSystem,objFolder) Dim objFile For Each objFile In objFolder.Files If InStr(1, sAllowedExtensions, _ objFileSystem.GetExtensionName(objFile.Name), vbTextCompare) > 0 Then If Not InStr(1, sDisallowFile, objFile.Path, vbTextCompare) > 0 Then If sSearchOnWhat = "all" Then Call Search_File(objFile) Else Call Search_Part(objFile) End If End If End If Next End Sub 'end of proc Process_Files Function Get_FileContents(paramFile) 'On Error Resume Next Dim objTxtStr Set objTxtStr = paramFile.OpenAsTextStream Get_FileContents = objTxtStr.ReadAll objTxtStr.Close Set objTxtStr = Nothing End Function 'end of Get_FileContents Function Extract_MetaTag(ByRef sTagName, ByVal sFileContents) 'On Error Resume Next Dim objRegExp, objMatches, sTitleInfo Extract_MetaTag = "" Set objRegExp = New RegExp objRegExp.Global = True objRegExp.IgnoreCase = True Select Case sTagName Case "title" objRegExp.Pattern = "<" & sTagName & ">[^>]*" Set objMatches = objRegExp.Execute(sFileContents) If objMatches.Count > 0 Then sTitleInfo = objMatches.Item(0) sTitleInfo = Replace(sTitleInfo,"","",1,-1,1) Else sTitleInfo = "No Title" End If Case Else objRegExp.Pattern = "]*>" Set objMatches = objRegExp.Execute(sFileContents) If objMatches.Count > 0 Then sTitleInfo = objMatches.Item(0) objRegExp.Pattern = "]*content=[^a-zA-Z0-9]?" sTitleInfo = objRegExp.Replace(sTitleInfo,"") objRegExp.Pattern = "[^a-zA-Z0-9]?>$" sTitleInfo = objRegExp.Replace(sTitleInfo,"") Else sTitleInfo = "No " & sTagName & " available." End If End Select If Err Then sIndexError = Err.Description lIndexErrorNum = Err.Number Err.Clear Extract_MetaTag = "" Exit Function End If Extract_MetaTag = sTitleInfo Set objMatches = Nothing Set objRegExp = Nothing End Function 'end of Extract_MetaTag Sub Show_Results() Dim mPage, i, mNumberPages, mDisplay, mDisplayNext mNumberPages = CInt((mNumResults / mMaxDisplayRecords)+.5) mPage = Request.QueryString("page") If mPage = "" Then mPage = 0 mDisplay = mPage * mMaxDisplayRecords If CInt(mPage) <> (mNumberPages -1) Then mDisplayNext = mDisplay + (mMaxDisplayRecords -1) Else mDisplayNext = mNumResults -1 End If Response.Write ResultHead_HTML(sSearchTerms, _ mNumResults,mDisplay,mDisplayNext) For i = mDisplay To mDisplayNext Response.Write ResultLine_HTML(i,sSearchResults(i,1),sSearchResults(i,2)) Next If mNumberPages > 1 Then Dim sLinksStr If mPage <> 0 Then sLinksStr = " « Previous" For i = 1 To mNumberPages If i = mPage + 1 Then sLinksStr = sLinksStr & " [" & i & "]" Else sLinksStr = sLinksStr & " " & i & "" End If Next If CInt(mPage) <> (mNumberPages -1) Then sLinksStr = sLinksStr & " Next »" Response.Write ResultFoot_HTML(sLinksStr) Else Response.Write ResultFoot_HTML(" ") End If End Sub 'end of proc Show_Results %>