*Home *
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
* *
  <% 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 Record_Search() On Error Resume Next Dim objFSO, objFile, sRecPath sRecPath = Server.MapPath("./incs/usedata.inc") Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(sRecPath, 8, True) If objFile.Line > 999 Then Set objFile = objFSO.GetFile(sRecPath) objFile.Delete(True) Set objFile = objFSO.OpenTextFile(sRecPath, 8, True) End If objFile.WriteLine(sSearchTerms & "|,|" & Now) objFile.Close Set objFile = Nothing Set objFSO = Nothing End Sub Sub Load_Index(mSection) On Error Resume Next Dim objXML, objLst, subLst, i, objRE, objFSO, mXMLMatch Dim sURL, sDesc, sTitle, mSearchThis sXMLFilePath = Server.MapPath("./incs/" & Replace(sUsersFile,".inc",".xml",1,-1,1)) Set objFSO = Server.CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(sXMLFilePath) Then Set objRE = New RegExp objRE.Global = True objRE.IgnoreCase = True Set objXML = Server.CreateObject("Microsoft.XMLDOM") objXML.Async="False" objXML.Load(sXMLFilePath) If objXML.parseError.errorCode <> 0 Then If mSection = 1 Then Call Process_Dirs("",1) Else Call Process_Dirs(sSearchInSection,2) End If End If Set objLst = objXML.getElementsByTagName("sfl_file") If mSection = 1 Then If sSearchOnWhat = "all" Then For i = 0 To objLst.Length - 1 Set subLst = objLst.item(i) mXMLMatch = Search_Node(objRE, subLst.childNodes(0).childNodes(0).Text _ & " " & subLst.childNodes(1).childNodes(0).Text _ & " " & subLst.childNodes(2).childNodes(0).Text) If mXMLMatch > 0 Then sURL = subLst.getAttribute("url") sTitle = subLst.childNodes(0).childNodes(0).Text sDesc = subLst.childNodes(1).childNodes(0).Text sSearchResults(mNumResults,1) = sURL & "<|>" & sTitle & "<|> " & sDesc _ & "<|>" & subLst.getAttribute("size") & "<|>" & subLst.getAttribute("name") _ & "<|>" & subLst.getAttribute("dlm") sSearchResults(mNumResults,2) = mXMLMatch mNumResults = mNumResults + 1 bMatchesMade = True End If Next Else Select Case sSearchOnWhat Case "url" mSearchThis = 0 Case "titles" mSearchThis = 0 Case "keywords" mSearchThis = 3 Case "desc" mSearchThis = 1 End Select For i = 0 To objLst.Length - 1 Set subLst = objLst.item(i) mXMLMatch = Search_Node(objRE, subLst.childNodes(mSearchThis).childNodes(0).Text) If mXMLMatch > 0 Then sURL = subLst.getAttribute("url") sTitle = subLst.childNodes(0).childNodes(0).Text sDesc = subLst.childNodes(1).childNodes(0).Text sSearchResults(mNumResults,1) = sURL & "<|>" & sTitle & "<|> " & sDesc _ & "<|>" & subLst.getAttribute("size") & "<|>" & subLst.getAttribute("name") _ & "<|>" & subLst.getAttribute("dlm") sSearchResults(mNumResults,2) = mXMLMatch mNumResults = mNumResults + 1 bMatchesMade = True End If Next End If Else If sSearchOnWhat = "all" Then For i = 0 To objLst.Length - 1 Set subLst = objLst.item(i) If InStr(1,subLst.getAttribute("path"),sSearchInSection,1) Then mXMLMatch = Search_Node(objRE, subLst.childNodes(0).childNodes(0).Text _ & " " & subLst.childNodes(1).childNodes(0).Text _ & " " & subLst.childNodes(2).childNodes(0).Text) If mXMLMatch > 0 Then sURL = subLst.getAttribute("url") sTitle = subLst.childNodes(0).childNodes(0).Text sDesc = subLst.childNodes(1).childNodes(0).Text sSearchResults(mNumResults,1) = sURL & "<|>" & sTitle & "<|> " & sDesc _ & "<|>" & subLst.getAttribute("size") & "<|>" & subLst.getAttribute("name") _ & "<|>" & subLst.getAttribute("dlm") sSearchResults(mNumResults,2) = mXMLMatch mNumResults = mNumResults + 1 bMatchesMade = True End If End If Next Else Select Case sSearchOnWhat Case "url" mSearchThis = 0 Case "titles" mSearchThis = 0 Case "keywords" mSearchThis = 3 Case "desc" mSearchThis = 1 End Select For i = 0 To objLst.Length - 1 Set subLst = objLst.item(i) If InStr(1,subLst.getAttribute("path"),sSearchInSection,1) Then mXMLMatch = Search_Node(objRE, subLst.childNodes(mSearchThis).childNodes(0).Text) If mXMLMatch > 0 Then sURL = subLst.getAttribute("url") sTitle = subLst.childNodes(0).childNodes(0).Text sDesc = subLst.childNodes(1).childNodes(0).Text sSearchResults(mNumResults,1) = sURL & "<|>" & sTitle & "<|> " & sDesc _ & "<|>" & subLst.getAttribute("size") & "<|>" & subLst.getAttribute("name") _ & "<|>" & subLst.getAttribute("dlm") sSearchResults(mNumResults,2) = mXMLMatch mNumResults = mNumResults + 1 bMatchesMade = True End If End If Next End If End If If objLst.Length = 0 Then If mSection = 1 Then Call Process_Dirs("",1) Else Call Process_Dirs(sSearchInSection,2) End If End If Else If mSection = 1 Then Call Process_Dirs("",1) Else Call Process_Dirs(sSearchInSection,2) End If End If If Err Then If mSection = 1 Then Call Process_Dirs("",1) Else Call Process_Dirs(sSearchInSection,2) End If Err.Clear End If Set subLst = Nothing Set objLst = Nothing Set objXML = Nothing Set objRE = Nothing End Sub Function Search_Node(objRegExp, sSearchOn) Dim objMatches, sSearchFor, sFileContents Dim sTmp, sPattern, i sSearchFor = Trim(sSearchTerms) sFileContents = sSearchOn 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 Search_Node = objMatches.Count Set objMatches = Nothing End Function Sub Return_Mappings() Dim sArray,i sArray = Split(sDirMappings,",") For i = 0 To Ubound(sArray) -1 If Not IsOdd(i) Then Response.Write "" 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, "\", "/",1,-1,1) '" 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, "\", "/",1,-1,1) '" 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 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 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) 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 %>