<%@ Language=VBScript %> <% Option Explicit %> <% Const adUseClient = 3 Const adOpenStatic = 3 Const adLockReadOnly = 1 Const sSearchImagePath = "/ISsearch/" Dim sErrorMsg, sNavBtnHTML, sSearchHTML, nSearchCount, nSearchScope, sScopePath, sSearchString, sSearchStats, nRankBase, nPageNum, nPageSize, nPageCount, sFormAction Dim gPageNum1, gPageNum2 Dim gRowNum1, gRowNum2 Main() Sub Main() nSearchScope = 1 nPageSize = 10 GetUIData() If sSearchString <> "" Then WindowsSearch(sSearchString) SetVariables() End If End Sub Sub GetUIData() ' nSearchScope Legend ' 1 = "www" ' 2 = "baremetal" ' 3 = "t-encrypt" sFormAction = Request.ServerVariables("PATH_INFO") sSearchString = GetRequestValue(Request.Form, "SearchString", "") nSearchScope = CLng(GetRequestValue(Request.Form, "SearchScope", nSearchScope)) nRankBase = CLng(GetRequestValue(Request.Form, "RankBase", 1000)) nPageNum = CLng(GetRequestValue(Request.Form, "Page", 1)) nPageCount = CLng(GetRequestValue(Request.Form, "PageCount", 1)) Select Case nSearchScope Case 1 sScopePath = "E:\Inetpub\Unylogix.com\www" Case 2 sScopePath = "E:\Inetpub\Unylogix.com\baremetal" Case 3 sScopePath = "E:\Inetpub\Unylogix.com\t-encrypt" Case Else sScopePath = "E:\Inetpub\Unylogix.com\www" End Select ' Uncomment for Testing ' If sSearchString = "" Then ' sSearchString = "sanbox" ' End If sSearchString = RemoveQuotes(sSearchString) sSearchString = TrimWhiteSpace(sSearchString) If GetRequestValue(Request.Form, "btnFirst", "") <> "" Then nPageNum = 1 ElseIf GetRequestValue(Request.Form, "btnPrev", "") <> "" Then nPageNum = nPageNum - 1 ElseIf GetRequestValue(Request.Form, "btnNext", "") <> "" Then nPageNum = nPageNum + 1 ElseIf GetRequestValue(Request.Form, "btnLast", "") <> "" Then nPageNum = nPageCount Else nPageNum = 1 Session("SearchConnection") = "" Session("SearchRecordSet") = "" End If End Sub Sub SetVariables() sNavBtnHTML = GetNavBtnHTML() End Sub Function WindowsSearch(sSearchText) Dim oConnection, oRecordSet, sSQL On Error Resume Next If IsObject(Session("SearchConnection")) And IsObject(Session("SearchRecordSet")) Then Set oConnection = Session("SearchConnection") Set oRecordSet = Session("SearchRecordSet") If oRecordSet.RecordCount > 0 And nPageNum > 0 Then oRecordSet.AbsolutePage = nPageNum End If Else Set oConnection = Server.CreateObject("ADODB.Connection") Set oRecordSet = Server.CreateObject("ADODB.Recordset") oRecordSet.CursorLocation = adUseClient oRecordSet.CursorType = adOpenStatic oRecordSet.LockType = adLockReadOnly Call oConnection.Open("Provider=Search.CollatorDSO;Extended Properties='Application=Windows';") ' Replace all single quotes with double single quotes to prevent SQL injection sSearchText = Replace(sSearchText, "'", "''") sSQL = "SELECT System.Title, System.Search.AutoSummary, System.FileExtension, System.ItemName, System.ItemDate, System.ItemPathDisplay, System.KindText, System.Size, System.Search.Rank " & _ "FROM SystemIndex " & _ "WHERE SCOPE = 'file:<@ScopePath@>'" & _ " AND SYSTEM.KINDTEXT != 'Folder'" & _ " AND (System.FileExtension = '.html' OR System.FileExtension = '.asp')" & _ " AND FREETEXT(*, '<@SearchText@>')" & _ " ORDER BY System.Search.Rank DESC" sSQL = Replace(sSQL, "<@ScopePath@>", sScopePath, 1, -1, vbTextCompare) sSQL = Replace(sSQL, "<@SearchText@>", sSearchText, 1, -1, vbTextCompare) Call oRecordSet.Open(sSQL, oConnection) oRecordSet.PageSize = nPageSize If Not oRecordSet.BOF And Not oRecordSet.EOF Then oRecordSet.MoveFirst End If End If ' CheckIsError(oConnection) nSearchCount = oRecordSet.RecordCount nPageCount = oRecordSet.PageCount sSearchHTML = GetSearchHTML(oRecordSet) If oRecordSet.RecordCount > 0 Then Set Session("SearchConnection") = oConnection Set Session("SearchRecordSet") = oRecordSet WindowsSearch = oRecordSet.RecordCount Else oRecordSet.Close() oConnection.Close() Set oRecordSet = Nothing Set oConnection = Nothing Set Session("SearchConnection") = Nothing Set Session("SearchRecordSet") = Nothing End If End Function Function GetNavBtnHTML() GetNavBtnHTML = " " If nPageCount > 1 Then GetNavBtnHTML = "
" & _ ">" & _ ">" & _ ">" & _ ">" & _ "Page: <@PageNum@> of <@PageCount@>" & _ "
" If nPageNum > 1 Then GetNavBtnHTML = Replace(GetNavBtnHTML, "<@DisableP@>", "", 1, -1, vbTextCompare) Else GetNavBtnHTML = Replace(GetNavBtnHTML, "<@DisableP@>", "disabled", 1, -1, vbTextCompare) End If If nPageNum < nPageCount Then GetNavBtnHTML = Replace(GetNavBtnHTML, "<@DisableN@>", "", 1, -1, vbTextCompare) Else GetNavBtnHTML = Replace(GetNavBtnHTML, "<@DisableN@>", "disabled", 1, -1, vbTextCompare) End If GetNavBtnHTML = Replace(GetNavBtnHTML, "<@PageNum@>", nPageNum, 1, -1, vbTextCompare) GetNavBtnHTML = Replace(GetNavBtnHTML, "<@PageCount@>", nPageCount, 1, -1, vbTextCompare) sSearchStats = "
Results: <@SearchCount@>
" sSearchStats = Replace(sSearchStats, "<@SearchCount@>", nSearchCount, 1, -1, vbTextCompare) End If End Function Function GetSearchHTML(ByRef oRecordSet) Dim sTemplateT1, sTemplateT2, sTemplateR1, sTemplateR2, sTemplateR3 Dim nRowNum, nRowNumLast Dim sHTML, sTemp, sValue, nRank, nNormRank, sStars On Error Resume Next sTemplateT1 = "" & vbCrLf sTemplateT2 = "
" & vbCrLf sTemplateR1 = "" & _ " <@RowNum@>" & _ " <@Title@>" & _ "" & vbCrLf sTemplateR2 = "" & _ "" & _ " <@Stars@>"" width=""90"" height=""20"">" & _ " " & _ "" & _ "<@Abstract@>" & _ "

"" class=""clsRecordStats"" style=""color:blue;"">http://<@ServerName@><@VPath@>" & _ "

<@Size@> bytes - <@ItemDate@> GMT

" & _ "" & _ "" & vbCrLf sTemplateR3 = "" & _ " Sorry, no matches were found." & _ "" & vbCrLf If Not oRecordSet.BOF And Not oRecordSet.EOF Then nRowNum = oRecordSet.AbsolutePosition nRowNumLast = nRowNum + oRecordSet.PageSize - 1 nPageNum = oRecordSet.AbsolutePage If oRecordSet.RecordCount <> -1 And oRecordSet.RecordCount < nRowNumLast Then nRowNumLast = oRecordSet.RecordCount End If ' This is the detail portion for Title, Abstract, URL, Size, and Modification Date. ' If there is a title, display it, otherwise display the filename. Do Until oRecordSet.EOF OR nRowNum > nRowNumLast sTemp = sTemplateR1 sTemp = Replace(sTemp, "<@RowNum@>", nRowNum, 1, -1, vbTextCompare) sValue = oRecordSet.Fields("System.Title").Value If VarType(sValue) = vbNull Or sValue = "" Then sValue = oRecordSet.Fields("System.ItemName").Value End If sTemp = Replace(sTemp, "<@Title@>", sValue, 1, -1, vbTextCompare) sHTML = sHTML & sTemp ' Graphically indicate rank of document with list of stars (*'s). nRank = CLng(oRecordSet.Fields("System.Search.Rank").Value) If nRowNum = 1 Then nRankBase = nRank If nRankBase > 1000 Then nRankBase = 1000 ElseIf nRankBase < 1 Then nRankBase = 1 End If End If nNormRank = nRank / nRankBase If nNormRank > 0.80 Then sStars = "rankbtn5.gif" ElseIf nNormRank > 0.60 Then sStars = "rankbtn4.gif" ElseIf nNormRank > 0.40 Then sStars = "rankbtn3.gif" ElseIf nNormRank > 0.20 Then sStars = "rankbtn2.gif" Else sStars = "rankbtn1.gif" End If sTemp = sTemplateR2 sTemp = Replace(sTemp, "<@ImagePath@>", sSearchImagePath, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Stars@>", sStars, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@ServerName@>", LCase(Request.ServerVariables("SERVER_NAME")), 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Abstract@>", oRecordSet.Fields("System.Search.AutoSummary").Value, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@VPath@>", MapURL(oRecordSet.Fields("System.ItemPathDisplay").Value), 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@ItemDate@>", oRecordSet.Fields("System.ItemDate").Value, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Size@>", oRecordSet.Fields("System.Size").Value, 1, -1, vbTextCompare) ' Construct the URL for hit highlighting ' WebHitsQuery = "CiWebHitsFile=" & Server.URLEncode( oRS("vpath") ) ' WebHitsQuery = WebHitsQuery & "&CiRestriction=" & Server.URLEncode( oQuery.Query ) ' WebHitsQuery = WebHitsQuery & "&CiBeginHilite=" & Server.URLEncode( "" ) ' WebHitsQuery = WebHitsQuery & "&CiEndHilite=" & Server.URLEncode( "" ) ' WebHitsQuery = WebHitsQuery & "&CiUserParam3=" & QueryForm ' WebHitsQuery = WebHitsQuery & "&CiLocale=" & oQuery.LocaleID sHTML = sHTML & sTemp oRecordSet.MoveNext nRowNum = nRowNum + 1 Loop End If If sHTML = "" Then sHTML = sTemplateR3 End If GetSearchHTML = sTemplateT1 & sHTML & sTemplateT2 End Function ' -------------------------------------------------------------------------- ' Name: GetRequestValue(ByRef oColl, ByVal sName, ByVal vDefaultValue) ' Return: Variant ' Description: Returns value from Request collection, if empty default value returned. ' -------------------------------------------------------------------------- Function GetRequestValue(ByRef oColl, ByVal sName, ByVal vDefaultValue) If TypeName(oColl) = "IRequestDictionary" And VarType(sName) = vbString Then GetRequestValue = oColl.Item(sName) End If If IsEmpty(GetRequestValue) Then GetRequestValue = vDefaultValue End If End Function Function MapURL(sPath) ' Opposite of server.mappath - takes a filesystem path and turns it into a url Dim sAppPath sAppPath = Server.MapPath("/") sPath = Replace(sPath, sAppPath, "", 1, -1, vbTextCompare) MapURL = Replace(sPath, "\", "/", 1, -1, vbTextCompare) End Function Function TrimWhiteSpace(sValue) TrimWhiteSpace = sValue On Error Resume Next Dim RegEx Set RegEx = New RegExp RegEx.Pattern = "(^\s+)|(\s+$)" RegEx.IgnoreCase = True RegEx.Global = True TrimWhiteSpace = RegEx.Replace(sValue, "") End Function Function RemoveQuotes(sValue) RemoveQuotes = sValue On Error Resume Next Dim RegEx Set RegEx = New RegExp RegEx.Pattern = """+" RegEx.IgnoreCase = True RegEx.Global = True RemoveQuotes = RegEx.Replace(sValue, "") End Function Function CheckIsError(ByRef r_oConnection) Dim bIsError bIsError = False sErrorMsg = "" If Not IsNull(r_oConnection) Then If TypeName(r_oConnection) = "Connection" Then If IsAdoError(r_oConnection) Then bIsError = True End If End If End If If IsAspError() Or IsVbsError() Then bIsError = True End If If bIsError Then Response.Write(sErrorMsg & VbCrLf) End If CheckIsError = bIsError End Function Function IsAdoError(ByRef r_oConnection) IsAdoError = False Dim Idx, nErrorCount, oADOConnection, sTemp, sErrTemplate Set oADOConnection = r_oConnection sErrTemplate = "ADO Error Object, " & _ "Error Number: <@ErrNum@>, " & _ "Description: <@Description@>, " & _ "NativeError: <@NativeError@>, " & _ "Source: <@Source@>, " & _ "SQLState: <@SQLState@>, " & _ "
, " & vbCrLf nErrorCount = oADOConnection.Errors.Count If nErrorCount > 0 Then For Idx = 0 To nErrorCount - 1 With oADOConnection.Errors.Item(Idx) If .Number <> 0 Then IsAdoError = True sTemp = sErrTemplate sTemp = Replace(sTemp, "<@ErrNum@>", .Number, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Description@>", .Description, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@NativeError@>", .NativeError, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Source@>", .Source, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@SQLState@>", .SQLState, 1, -1, vbTextCompare) End If End With Next If sTemp <> "" Then sErrorMsg = sErrorMsg & sTemp End If oADOConnection.Errors.Clear() End If Set oADOConnection = Nothing End Function ' IsAspError ----------------------------- Function IsAspError() IsAspError = False Dim oASPError, sTemp, sErrTemplate sErrTemplate = "ASPError Object, " & _ "ASPCode: <@ASPCode@>, " & _ "ASPDescription: <@ASPDescription@>, " & _ "Description: <@Description@>, " & _ "Number: <@Number@>, " & _ "Source: <@Source@>, " & _ "Category: <@Category@>, " & _ "File: <@File@>, " & _ "Line: <@Line@>, " & _ "Column: <@Column@>, " & _ "
, " & vbCrLf Set oASPError = Server.GetLastError() With oASPError If .ASPCode > "" Or _ .ASPDescription > "" Or _ .Number <> 0 Or _ .Description > "" Or _ .File <> "" And _ .File <> "?" Then IsAspError = True sTemp = sErrTemplate sTemp = Replace(sTemp, "<@ASPCode@>", .ASPCode, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@ASPDescription@>", .ASPDescription, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Description@>", .Description, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Number@>", .Number, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Source@>", .Source, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Category@>", .Category, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@File@>", .File, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Line@>", .Line, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Column@>", .Column, 1, -1, vbTextCompare) If sTemp <> "" Then sErrorMsg = sErrorMsg & sTemp End If End If End With Set oASPError = Nothing End Function ' IsVbsError ----------------------------- Function IsVbsError() IsVbsError = False Dim sTemp, sErrTemplate sErrTemplate = "Error (Err) Object, " & _ "Number: <@Number@>, " & _ "Description: <@Description@>, " & _ "Source: <@Source@>, " & _ "
, " & vbCrLf With Err If .Number <> 0 Then IsVbsError = True sTemp = sErrTemplate sTemp = Replace(sTemp, "<@Number@>", .Number, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Description@>", .Description, 1, -1, vbTextCompare) sTemp = Replace(sTemp, "<@Source@>", .Source, 1, -1, vbTextCompare) If sTemp <> "" Then sErrorMsg = sErrorMsg & sTemp End If .Clear() End If End With End Function %> Search for a keyword in Unylogix pages
 

Search the Unylogix Web site

Enter your query below:
<%=sSearchStats%>
<%=sNavBtnHTML%>
<%=sSearchHTML%>
<%=sNavBtnHTML%>