<% Dim strSQL, objRS, phrase, top, member, criteria, forumid, arrPh, ub Dim searchmode,timeoffset,strADD,strSubject,strBody,language,searchstring Dim messageID, subject, datecreated, onclick, author, topicreply, message, topicreplySymbol, searchFor Dim timefilter, timeframe, timephrase,fuzzyMatch, FAQSearch, minRank, currpage, rdcount, mpg, pages Dim keyAndLan appid = request.queryString("appid")&"" phrase = lcase(trim(request.queryString("phrase"))&"") topicreply = request.queryString("topicreply")&"" ' topic or reply or both message = request.queryString("message")&"" 'subject or body or both top = request.queryString("top")&"" language = request.queryString("language")&"" criteria = request.queryString("criteria")&"" member = Trim(request.queryString("author")&"") searchFor = request.queryString("searchfor")&"" timefilter = request.queryString("timefilter")&"" timeframe = request.queryString("timeframe")&"" fuzzyMatch = request.queryString("fuzzyMatch")&"" FAQSearch = request.queryString("FAQSearch")&"" minRank = request.queryString("minRank")&"" page = request.queryString("p")&"" mpg = Application(dbName&"tpg") searchmode = Application(dbName&"searchmode") timeoffset = Application(dbName&"timeoffset") Dim arrforumAllowed, allowedForum, iforums, finalforums Dim allforum:allforum = Application(dbName&"foruminfo") Dim search:search=true Dim searchError:searchError = "" Dim strFullTextADD, strFullTextSELECT, strFullTextOrder, strFullTextColspan, strFullTextColWidth '==== making up the default values==== if len(appid) = 0 then appid = "ALL" if len(topicreply) = 0 then topicreply = "both" if len(message) = 0 then message = "both" if searchmode = "full text" and message = "both" then message = "*" if fuzzyMatch = "on" then fuzzyMatch = "FreeTextTable" else fuzzyMatch = "ContainsTable" if len(minRank) = 0 then minRank = "10" if len(criteria) = 0 then criteria = "AND" if len(language) = 0 then language = "single" member = SQLStrip(member) if len(member)<>0 then dim authorType authorType="LIKE" if right(member,1)<>"%" or left(member,1)="%" then authorType = "=" else member = "Anyone" end if if left(member,1)="%" then member = "Anyone" SELECT Case top Case "10","20","50","100","200","300" Case else top = "50" End SELECT if topicreply = "topic" then topicreplySymbol = "=" elseif topicreply = "reply" then topicreplySymbol = ">" elseif len(topicreply) = 0 then topicreply= "both" end if 'response.write timefilter 'response.end if timefilter <> "0" and timefilter <> "" and timeframe<>"" then timephrase = "dateCreated "&timeframe&" DateADD (d, "&Cint(timefilter)&", GetDate())" elseif timefilter = "0" then timephrase = "" else timephrase = "dateCreated > DateADD (d, -30, GetDate())" end if 'response.write timephrase 'response.end ' the following for full text mode strFullTextADD = "" strFullTextSELECT = "" strFullTextOrder = "" strFullTextColspan = 0 strFullTextColWidth = 5 ' the following for normal query mode strADD = "" strSubject = "" strBody = "" '===== making up a list of forums to search in === if isArray(allforum) then Dim objSearchableForum Set objSearchableForum = new searchableForum With objSearchableForum .memID = memID .SearchType = appid if (searchfor = "approve" or searchfor = "recycle") then .moderatorOnly = true finalforums = .GetSearchableForums End With Set objSearchableForum = nothing else finalforums = "-5" end if if not response.isclientconnected then response.end '=== start building search string === Dim word SELECT CASE criteria case "AND" word= srRCAllWord case "OR" word= srRCOrWord case "exact" word= srRCExactPhrase END SELECT phrase = SQLstrip(phrase) if len(phrase) <> 0 then SELECT CASE searchmode CASE "full text" if searchfor = "" then SELECT CASE criteria Case "exact" strFullTextADD = "INNER JOIN "&fuzzyMatch&" (pgd_messages,"&message&",'"""&phrase&"""',"&top&") ft on M.messageID = ft.[Key]" Case "AND", "OR" phrase = " " & replace(phrase,","," ") & " " phrase = replace(replace(replace(phrase," and "," ")," or "," ")," not "," ") ' Strip away all possible problematic keywords phrase = CheckDelimitedFormat(phrase," ") phrase = replace(phrase," "," "&criteria&" ") strFullTextADD = "INNER JOIN "&fuzzyMatch&" (pgd_messages,"&message&",'"&phrase&"',"&top&") ft on M.messageID = ft.[Key]" phrase = replace(phrase," "&criteria&" ",",") ' response.write strFullTextADD ' response.end END SELECT strFullTextSELECT = ", Rank " strFullTextOrder = " Rank DESC, " strFullTextColspan = 1 strFullTextColWidth = 3 end if CASE ELSE SELECT CASE criteria CASE "exact" 'if we want to search all words or any words strSubject = "Subject LIKE '%"&phrase&"%'" strBody = "Body LIKE '%"&phrase&"%'" CASE ELSE '=================================================== ' Some of the very common words are not allowed. ' Like those filters in Google ' We first find out how the user separate their search string '=================================================== phrase=space(1)&replace(phrase,","," ")&space(1) 'convert "," into space, meaning finally we based our search in space Dim notallowed, arrnotallowed,i arrnotallowed=split(notallowed,",") for i=0 to ubound(arrnotallowed,1) arrnotallowed(i)=trim(arrnotallowed(i)) arrnotallowed(i)=space(1)&arrnotallowed(i)&space(1) phrase=replace(phrase,arrnotallowed(i)," ", 1, -1,vbTextCompare) ' strip away nonsence word next erase arrnotallowed phrase = CheckDelimitedFormat(phrase," ") arrPh = split(phrase," ") '=================================================== ' We now construct final string of the search string. Words that ' is zero in length or too short (less then 2 characters) are all stripped ' out. '=================================================== phrase="" for i=0 to ubound(arrPh) if Len(arrPh(i))>2 then phrase=phrase&","&arrPh(i) else phrase=phrase end if next erase arrPh phrase = CheckDelimitedFormat(phrase,",") '=================================================== ' Put the final string into an array, called "arrPh", and see if there ' is something to search, if no, tell the user no string is found '=================================================== if len(trim(phrase))=0 and len(searchfor)=0 and member="Anyone" then search = false searchError = srTermTooShort end if Dim lantype, subType Dim phHead, phTail, phDelimit phTail = "%' )" SELECT CASE language CASE "double" phHead = "(Subject LIKE '%" : phDelimit = "%' "&criteria&" Subject LIKE '%" CASE ELSE phHead = "(Subject LIKE '% " :phDelimit = "%' "&criteria&" Subject LIKE '% " END SELECT strSubject = phHead&replace(phrase,",",phDelimit)&phTail SELECT CASE language CASE "double" phHead = "(Body LIKE '%" : phDelimit = "%' "&criteria&" Body LIKE '%" CASE ELSE phHead = "(Body LIKE '% " :phDelimit = "%' "&criteria&" Body LIKE '% " END SELECT strBody = phHead&replace(phrase,",",phDelimit)&phTail '==============end of search updates======================== END SELECT ' ends normal query criteria str building strADD = strBuilder(strSubject,strBody,message) ' builds all str for normal query END SELECT ' ends select between normal query and full text end if Dim arrCombined(5) if topicreply = "combined" then if searchmode = "full text" then arrCombined(1) = ", FM.Rank" arrCombined(2) = ", SUM(THR.Rank) as Rank" arrCombined(3) = " Having SUM(THR.Rank) >= "&minRank arrCombined(4) = " FM.Rank DESC" arrCombined(5) = ", Rank" else arrCombined(1) = "" arrCombined(2) = ", count(*) as counts" arrCombined(3) = "" arrCombined(4) = " FM.counts DESC" arrCombined(5) = "" end if end if if topicreply = "combined" then strSQL = _ "SELECT top "&top&" messageID, searchstring, Subject, datecreated, P.login, FM.forumTitle, FM.forumID, msgIcons, OM.mem, Locked, moderated"& arrCombined(1) &VBCRLF&_ "FROM pgd_Messages OM with (nolock)"&VBCRLF&_ "INNER JOIN"&VBCRLF&_ "("&VBCRLF&_ "SELECT THR.threadID, THR.forumID, THR.forumTitle"& arrCombined(2) &VBCRLF&_ "FROM ("&VBCRLF&_ "SELECT top "&(cint(top)*2)&" M.threadID"&arrCombined(5)&", M.forumID, f.forumTitle"&VBCRLF else strSQL = _ "SELECT top "&top&" messageID, searchstring, Subject, datecreated, p.login, f.forumTitle, f.forumID, msgIcons, M.mem, Locked, moderated"&strFullTextSELECT&VBCRLF end if strSQL = strSQL &_ "FROM pgd_Messages M with (nolock)"&VBCRLF& _ "INNER JOIN (SELECT forumtitle, forumID FROM pgd_forums WHERE forumID in ("&finalforums&")) f ON M.forumID = f.forumID "&VBCRLF&_ strFullTextAdd&VBCRLF ' if topicreply <> "combined" then strSQL = strSQL & VBCRLF& "INNER JOIN (SELECT login, mem FROM pgd_members with (nolock)) p ON M.mem = p.mem"&VBCRLF ' end if strSQL = strSQL & "WHERE ("&VBCRLF Dim qStr:qStr = "" if searchFor = "" then if phrase <> "" and searchmode = "normal query" then qStr = "("&strADD&")" elseif strFullTextColspan = 1 then qStr = "(Rank >= "&minRank&")" end if if CheckedOrNot(FAQSearch) = 1 then qStr = qStr & "|(isFAQ = 1)" end if '=================== changed part +=================== if member <> "Anyone" then qStr = qStr & "|(p.login "&authorType&" '"&member&"')" end if '=================== changed part -=================== if topicreply<>"both" and topicreply <> "combined" then qStr = qStr & "|(parent"&topicreplySymbol&"0)" end if if timephrase<>"" then qStr = qStr & "|("&timephrase&")" end if qStr = replace(CheckDelimitedFormat(qStr,"|"),"|"," AND ") strSQL = strSQL & qStr strSQL=strSQL&")"&VBCRLF strSQL=strSQL&"ORDER BY"&strFullTextORDER&" dateCreated DESC, f.forumID" strSQL = replace(strSQL,"WHERE ()","") end if '=================== changed part +=================== if topicreply = "combined" then strSQL = strSQL &_ ") THR"&VBCRLF&_ "Group By THR.threadID, THR.forumID, THR.forumTitle "&arrCombined(3)&VBCRLF&_ ") FM"&VBCRLF&_ "on FM.threadID = OM.messageID"&VBCRLF&_ "INNER JOIN (SELECT login, mem FROM pgd_members with (nolock)) p ON OM.mem = p.mem"&VBCRLF ' if member <> "Anyone" then ' strSQL = strSQL & "WHERE (p.login "&authorType&" '"&member&"')"&VBCRLF ' end if strSQL = strSQL & "ORDER BY "&arrCombined(4)&", datecreated DESC" end if '=================== changed part -=================== 'response.write phrase&"
" 'response.write search&"
" 'response.write searchFor&"
" 'response.write ("") 'response.end on error resume next if len(page) <> 0 then currpage = cdbl(abs(page)) else currpage = 1 if currpage = 0 then currpage = 1 Dim results 'final results Dim ubsearch Dim objCom Dim specialInput Dim tempResults Dim iFirst, iLast, iStep if member <> "Anyone" and len(phrase) = 0 then searchFor = "author" if searchFor = "author" then specialInput = trim(member) else specialInput = SQLMediumDate(memLastVisit) end if if not response.isclientconnected then response.end if search then SELECT CASE searchFor Case "" set objRS = server.createobject("adodb.recordset") objRS.cachesize = mpg objRS.open strSQL, datastore, , , adCmdText if not (objRs.EOF OR objRS.BOF) Then results = objRS.GetRows end if objRS.close Set objRS = nothing Dim ubHasRank if isArray(results) then rdcount = ubound(results,2)+1 ubHasRank = ubound(results,1) if ubHasRank = 11 then strFullTextColspan = 1 end if Case else strSQL = "spSearchFor"&searchFor if (searchfor = "today" or searchfor = "lastvisit") and Application(dbName&"todayLastVisitPref")=1 then _ strSQL = strSQL&"1" set objRS = server.createobject("adodb.recordset") objRS.cachesize = mpg Set objCom = server.createobject("adodb.command") with objCom .activeconnection = datastore '.commandTimeout = 200 .commandText = dbOwnerPrefix&strSQL .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@RETURN_VALUE", adInteger, adParamReturnValue, 0 ) .Parameters.Append .Createparameter("@searchFor", adVarChar, adParamInput, 30, lcase(searchFor)) .Parameters.Append .Createparameter("@int_currpage", adInteger, adParamInput, 0, currpage) .Parameters.Append .Createparameter("@rdcount", adInteger, adParamOutput, 0 ) .Parameters.Append .Createparameter("@specialInput", adVarChar, adParamInput, 50, specialInput) .Parameters.Append .Createparameter("@topSelect", adInteger, adParamInput, 0, top) .Parameters.Append .Createparameter("@IDList", adVarChar, adParamInput, 2000, finalforums) set objRS = .execute if objRS.state <> adStateclosed then results = objRS.getrows objRS.close end if set objRS = nothing rdcount = .Parameters("@rdcount").value end with Set objCom = nothing End SELECT Dim allDeleted set objRS = server.createobject("adodb.recordset") objRS.cachesize = mpg objRS.open "SELECT messageID from pgd_recycleBin B with (nolock) WHERE exists (SELECT messageID FROM pgd_messages M with (nolock) WHERE M.messageID = B.messageID and M.forumID in ("&finalforums&"))", datastore, , , adCmdText if not (objRs.EOF OR objRS.BOF) Then allDeleted = trim(objRS.getString(,,"",",","")) end if objRS.close Set objRS = nothing if not isarray(results) then search = false searchError = srProNoFoundDesc end if end if 'on error goto 0 'response.write ("") 'response.end if search then if (rdcount mod mpg) <> 0 then pages = (rdcount\mpg)+1 else pages = (rdcount\mpg) if currpage>pages then currpage = pages: ubsearch = ubound(results,2) if len(searchFor) <> 0 then iFirst = ubsearch:iLast = 0:iStep = -1 else iStep = 1 iFirst = (currpage - 1) * mpg iLast = iFirst + mpg - 1 if iLast > ubsearch then iLast = ubsearch end if end if keyAndLan = "&key="& server.URLencode(""&phrase) 'response.write iFirst&"
" 'response.write iLast 'response.write rdcount 'response.end '============================================================================= 'messageID , searchstring , subject , datecreated, author, forumTitle, forumID, msgIcon, mem, islocked, moderated, rank ' 0 1 2 3 4 5 6 7 8 9 10 11 '============================================================================= %> <%= Application(dbName&"forumtitle") %> <%= OutputCSS() %> > <% call headerHTML() %>
 ><%= srProResultDesc %>
<% if strFullTextColspan = 1 then %> <% end if %> <% Dim forumTitle, fappid, mem, msgIcon, islocked, moderated, mode, rank Dim showLink: showLink = false Dim hideDeleted:hideDeleted = false Dim isDeleted:isDeleted = false if search then Set objPermission = new PermissionSetting With objPermission .memID = memID for i= iFirst to iLast step iStep isDeleted = false showLink = false hideDeleted = false messageID=results(0,i) searchstring=SQLout(results(1,i)) subject=SQLout(results(2,i)) datecreated=results(3,i) author=results(4,i) forumTitle = results(5,i) fappid = forumIDtoappid(results(6,i)) msgIcon = results(7,i) mem = results(8,i) islocked = results(9,i) moderated = results(10,i) if ubHasRank = 11 then rank = results(11,i) .appid = fappid mode = .Moderator() if Instr(1, "," & allDeleted & ",", "," & messageID & ",", 0) > 0 then 'response.write "true" isDeleted = true if isAdmin or mode then hideDeleted = false else hideDeleted = true end if end if if moderated <> 1 then showLink = true elseif (moderated=1 and (isAdmin or mode or (cstr(mem)=memID and not isGuest))) then showLink = true end if Dim poster if mem <> -1 then poster = ""&author&"" else poster = author end if %> <% if strFullTextColspan = 1 then %> <% end if %> <% if i = iLast and len(searchFor)>0 then %> <% elseif i = iLast and len(searchFor)=0 then %> <% end if %> <% next %> <% End With Set objPermission = nothing %> <% else %> <% end if %>
<%= tableinside %>> <% if len(searchfor) = 0 then%>
 &appid=<%= appid %>"><%= srTitleDesc %> >> <%= replace(replace(replace(srProCriteriaDesc,"#criteria#",word),"#srTerms#",SQLout(replace(phrase,"''","'"))),"#author#",member) %>

<% else %> <% Dim allCat, p, q, checkModerator:checkModerator = false Dim fStr, isCategroyAccessible, ModeratorReadable:ModeratorReadable = false Dim objPermission Dim allmoderators:allmoderators = "" allForum=Application(dbName&"foruminfo") allCat=Application(dbName&"Category") if isArray(allforum) and not isAdmin then Dim moderatorArray:moderatorArray = ExtractOneDimension(allforum, 11) allmoderators = Join(moderatorArray,",") end if %>
<%= srSearchForDesc %> <% if searchfor<>"author" then %> <% Else %> <% end if %> <%= srSearchForInForumDesc %>  

<% end if %>
 <%= srcRankDesc %><%= ttTopic %> <%= srForumProDesc %> <%= srByNameDesc %> <%= srPostDate %>
align="center" width="3%"> align="center" width="3%"> align="left" class="ultrasmall" width="5%" nowrap><%= rank %>/1000
 class="c2"> <% if isDeleted then %> <%= ttDeletedTopic %> <% elseif moderated=1 then%> <%= ttAwaitMode %> <% end if %> <% if showLink and not hideDeleted then %> <%= SQLout(subject) %> <% end if %> align="center" class="c2"><%= forumTitle %> align="center" class="c2"><%= poster %> align="right" nowrap width="10%"> <% if showLink and not hideDeleted then%> <%= SQLdate(datecreated, timeoffset, true) %>
<%= searchOpenNewWin %> <% else %>   <% end if %>
align=center <%= tableinside %>>
<%= rdcount & searchRecordReturned%>

<% If len(searchfor) <> 0 then %> <% For each searchQ in request.queryString if searchQ <> "p" then%> "> <% end if Next %> <% End If%>
align=center <%= tableinside %>>
<%= rdcount & searchRecordReturned%>

<% If len(searchfor) = 0 then %> <% Dim searchQ For each searchQ in request.queryString if searchQ <> "p" then%> "> <% end if Next %> <% End If%>
colspan=<%= (6+strFullTextColspan) %> class="subhead" align="center">

<%= searchError %>


<% call footerHTML() %>