<% Function zSearch_Main(ByRef zSearchText, ByVal zSearchType) '# before this is called, zstrSQL is created with a default string - no search parameters # '-- adds search criteria to SQL statement -- Dim zTmpWords zSearchText = Replace(zSearchText,"'","''") 'sql doesnt fall over at apostrophes If LCase(zSearchType) = "title" Then zTmpWords = "news.Title LIKE '%" & zSearchText & "%'" ElseIf LCase(zSearchType) = "allpost" Then zTmpWords = "(news.Title LIKE '%" & zSearchText & "%' OR news.Content LIKE '%" & zSearchText & "%')" Else zTmpWords = "news.Content LIKE '%" & zSearchText & "%'" End If zSearch_Main = zTmpWords & " AND " End Function Function zSearch_Date(ByRef zDaysBack) '# adds a search query to the sql looking for posts within certain dates # If zDaysBack <> "" And IsNumeric(zDaysBack) Then 'user searched days If CInt(zDaysBack) = 0 Then zSearch_Date = "" Exit Function Else zDaysBack = Abs(CInt(zDaysBack)) 'always positive End If ElseIf DaysPerPage > 0 Then 'invalid/no search, but admin has a value set in daysperpage zDaysBack = DaysPerPage Else zSearch_Date = "" Exit Function End If Dim zTmpDate1 zTmpDate1 = DateAdd("d",(zDaysBack * -1),Now) 'gets date from [zintDaysBack] days ago zTmpDate1 = Year(zTmpDate1) & Right("0"&Month(zTmpDate1),2) & Right("0"&Day(zTmpDate1),2) 'converts it to yyyymmdd zSearch_Date = "news.DateStamp >= " & zTmpDate1 & " AND " End Function Function zSearch_Category(userRequest) 'searches category Dim zTmp1 zTmp1 = "" If PageSubCategory <> "" And InStr(PageSubCategory,",") <> 0 Then 'pagesubcat gets particular cats.. If IsNumeric(Replace(PageSubCategory,",","")) Then 'multiple cats zTmp1 = "news.Category IN (" & PageSubCategory & ")" End If ElseIf PageSubCategory <> "" And IsNumeric(PageSubCategory) Then 'single cat zTmp1 = "news.Category LIKE " & PageSubCategory End If If userRequest <> "" And IsNumeric(userRequest) Then 'this allows user search, but only in cats at pagelevel If zTmp1 <> "" Then 'categories have been filtered from pagesubcategory If InStr(","&PageSubCategory&",",","&userRequest&",") <> 0 Then 'works out if cat request is allowed on page zTmp1 = "news.Category LIKE " & userRequest End If Else 'no page level filter zTmp1 = "news.Category LIKE " & userRequest End If End If If zTmp1 <> "" Then 'category search made zTmp1 = zTmp1 & " AND " End If zSearch_Category = zTmp1 End Function Function zSearch(indexSearch) '# writes the WHERE criteria for sql string # Dim tmpSQL If zblnSinglePost And Not indexSearch Then tmpSQL = "WHERE news.PostID LIKE " & Trim(Request.QueryString("postid")) Else Dim zstrSearchText,zstrSearchType,zintSearchUser,zintSearchCategory,zintDaysBack zstrSearchText = Server.HTMLEncode(Trim(Request.QueryString("searchword"))) zstrSearchType = LCase(Trim(Request.QueryString("searchin"))) zintSearchUser = Trim(Request.QueryString("userid")) zintSearchCategory = Trim(Request.QueryString("category")) zintDaysBack = Trim(Request.QueryString("daysback")) tmpSQL = "WHERE " Dim tmpSearch tmpSearch = False If zstrSearchText <> "" Then tmpSQL = tmpSQL & zSearch_Main(zstrSearchText,zstrSearchType) tmpSearch = True End If If zintSearchUser <> "" And IsNumeric(zintSearchUser) Then tmpSQL = tmpSQL & "news.PostedBy LIKE " & zintSearchUser & " AND " tmpSearch = True End If If PageSubCategory <> "" Or zintSearchCategory <> "" Then tmpSQL = tmpSQL & zSearch_Category(zintSearchCategory) End If If Not tmpSearch And (zintDaysBack <> "" Or DaysPerPage >= 1) Then tmpSQL = tmpSQL & zSearch_Date(zintDaysBack) End If If Len(tmpSQL) > 6 Then 'additional search made tmpSQL = Left(tmpSQL,(Len(tmpSQL) - 5)) 'removes the last " AND " from the statement Else tmpSQL = "" End If End If zSearch = tmpSQL End Function Sub zStart_Pages() Dim zTmpRS,zTmpComm Set zTmpComm = Server.CreateObject("ADODB.Command") zTmpComm.ActiveConnection = zobjConn zTmpComm.CommandType = adCmdText zTmpComm.CommandText = "SELECT COUNT(*) As rscount FROM userInfo INNER JOIN (news INNER JOIN categories ON news.Category LIKE categories.Category) ON news.PostedBy LIKE userInfo.UserID " & zSearch(False) Set zTmpRS = zTmpComm.Execute If Not zTmpRS.EOF Then zintPages = Int((zTmpRS("rscount") / PostsPerPage) + 0.99) 'works how many pages there could be zintPage = Trim(Request.QueryString("page")) 'takes user input If zintPage <> "" And IsNumeric(zintPage) Then 'validates zintPage = CInt(zintPage) Else zintPage = 1 'invalid, so revert to page 1 End If If zintPage > zintPages Then 'page must be within range zintPage = zintPages End If Else zintPage = 0 zintPages = 0 End If Set zTmpRS = Nothing 'destroys Set zTmpComm = Nothing 'destroys End Sub Sub zStart_News() 'gets data from storage, manipulates it and then converts it to array format Dim zstrSQL zstrSQL = "SELECT news.PostID, news.Title, news.PostedDate, news.Content, news.Comments, categories.CategoryName, userInfo.UserName, userInfo.Email FROM userInfo INNER JOIN (news INNER JOIN categories ON news.Category LIKE categories.Category) ON news.PostedBy LIKE userInfo.UserID " & zSearch(False) & " ORDER BY news.PostID DESC " Set zobjRS1 = Server.CreateObject("ADODB.Recordset") zobjRS1.CursorLocation = 3 zobjRS1.Open zstrSQL, zobjConn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not zobjRS1.EOF Then '-- figures out how many pages there are, and what page is currently chosen -- If zintPage = "" Or Not IsNumeric(zintPage) Then Call zStart_Pages() 'assigns values to zintPage and zintPages for the first time End If '-- archive / multiple page stuff -- If Not zblnSinglePost And PostsPerPage > 0 Then '-multiple page navigation If zintPage >= 2 Then zobjRS1.Move +((zintPage - 1) * PostsPerPage) 'moves recordset on to the requested page End If zobjRS = zobjRS1.GetRows(PostsPerPage) 'only create array with posts that will be displayed Else 'dont pass a limit to the array zobjRS = zobjRS1.GetRows() End If End If zobjRS1.Close '# all news posts that will be written are now contained in the array: zobjRS End Sub Sub zStart_Comments() Dim zstrSQL If zblnSinglePost Then zstrSQL = "SELECT comments.PostID, comments.PostedDate, comments.PostedBy, comments.Comment FROM comments WHERE comments.PostID LIKE " & zobjRS(0,0) & " ORDER BY comments.CommentID" Else zstrSQL = "SELECT comments.PostID, comments.PostedDate, comments.PostedBy, comments.Comment FROM comments WHERE comments.PostID BETWEEN " & zobjRS(0,UBound(zobjRS,2)) & " AND " & zobjRS(0,0) & " ORDER BY comments.CommentID" End If zobjRS1.Open zstrSQL, zobjConn, adOpenForwardOnly, adLockReadOnly, adCmdText End Sub Sub zWrite() '# calls the write function as many times as neccessary # Dim i,ii,zLimit,zLimit1 zLimit = UBound(zobjRS,2) If zblnSinglePost Or CommentsPerPost = 0 Then zLimit1 = 1000 'no limit; theres never going to be 1000 comments to a news post Else zLimit1 = CommentsPerPost 'limit is admin set End If For i = 0 To zLimit '-- write news post -- Response.Write "
" & zWrite_News(i,zLimit1) & "
" Response.Flush 'sends the post to browser '-- write comments for post -- If zLimit1 > 0 And zobjRS(4,i) > 0 Then 'if comments exist, and to be written zobjRS1.Filter = "PostID LIKE '" & zobjRS(0,i) & "' " 'get comments collection If zblnSinglePost Then Response.Write "
" Else Response.Write "" Response.Flush 'send comments to browser End If Next If zblnSinglePost Then Server.Execute "/kaos/displayForm.asp" End If End Sub Sub zWrite_SearchCategory() 'searchform category dropdown Set zobjRS1 = Server.CreateObject("ADODB.Recordset") zobjRS1.Open "SELECT * FROM categories ORDER BY Category", zobjConn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not zobjRS1.EOF Then Response.Write "" & vbcrlf If PageSubCategory <> "" Then 'used when subcategories displayed is limited at page level Do While Not zobjRS1.EOF If InStr("," & PageSubCategory & ",","," & zobjRS1("Category") & ",") <> 0 Then Response.Write "" & vbcrlf End If zobjRS1.MoveNext Loop Else 'normal/default use of page Do While Not zobjRS1.EOF Response.Write "" & vbcrlf zobjRS1.MoveNext Loop End If End If zobjRS1.Close Set zobjRS1 = Nothing End Sub Sub zWrite_SearchUsers() 'searchform users dropdown Set zobjRS1 = Server.CreateObject("ADODB.Recordset") zobjRS1.Open "SELECT UserID,Username FROM userInfo", zobjConn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not zobjRS1.EOF Then Response.Write "" & vbcrlf Do While Not zobjRS1.EOF Response.Write "" & vbcrlf zobjRS1.MoveNext Loop End If zobjRS1.Close Set zobjRS1 = Nothing End Sub Sub displayIndex() 'writes index to browser Set zobjRS1 = Server.CreateObject("ADODB.Recordset") zobjRS1.CursorLocation = 3 Dim zstrSQL zstrSQL = "SELECT news.PostID, news.Title, news.PostedDate, userInfo.UserName, categories.CategoryName FROM userInfo INNER JOIN (news INNER JOIN categories ON news.Category LIKE categories.Category) ON news.PostedBy LIKE userInfo.UserID " & zSearch(True) & " ORDER BY news.PostID DESC" zobjRS1.Open zstrSQL, zobjConn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not zobjRS1.EOF Then '-- figures out how many pages there are, and what page is currently chosen -- If zintPage = "" Or Not IsNumeric(zintPage) Then Call zStart_Pages() 'assigns values to zintPage and zintPages for the first time End If '-- skip through posts -- If Not zblnSinglePost And PostsPerIndex <> 0 Then If PostSkipInIndex > 0 Then zobjRS1.Move PostSkipInIndex 'moves recordset x number of posts ElseIf PostSkipInIndex = -1 Then zobjRS1.Move +(PostsPerPage*zintPage) 'moves recordset to posts older than those displayed on current page End If End If End If '-- create array of posts wanted If Not zobjRS1.EOF Then If PostsPerIndex = 0 Then 'no limit zobjRS = zobjRS1.GetRows() ElseIf zobjRS1.RecordCount > PostsPerIndex Then 'more posts in db than required zobjRS = zobjRS1.GetRows(PostsPerIndex) 'so give it a limit Else 'less in db than max required, so take all zobjRS = zobjRS1.GetRows() End If '-- closedown -- zobjRS1.Close Set zobjRS1 = Nothing '-- display -- Dim i, ii ii = UBound(zobjRS,2) For i = 0 To ii Response.Write zWrite_Index(i) Next Erase zobjRS Else '-- closedown -- zobjRS1.Close Set zobjRS1 = Nothing Response.Write "no previous posts" End If End Sub Sub displayPageNav() 'writes page navigation links to browser 'If Not zblnSinglePost Then 'only displays on main display page '-- figures out what the current pagename is -- If Request.ServerVariables("QUERY_STRING") <> "" Then '-- remove other page=x references -- Dim zobjRegExp,zstrQS,zstrSelf1 Set zobjRegExp = New RegExp zobjRegExp.IgnoreCase = True zobjRegExp.Global = True zobjRegExp.Pattern = "&?page=(\w)+" zstrQS = Request.ServerVariables("QUERY_STRING") zstrQS = zobjRegExp.Replace(zstrQS,"") Set zobjRegExp = Nothing End If If zstrQS <> "" Then zstrSelf1 = zstrSelf & "?" & zstrQS & "&" Else zstrSelf1 = zstrSelf & "?" End If '-- figures out how many pages there are, and what page is currently chosen -- If zintPage = "" Or Not IsNumeric(zintPage) Then Call zStart_Pages() 'assigns values to zintPage and zintPages for the first time End If '-- now writes the page navigation links -- Response.Write "Page " & zintPage & " of " & zintPages & "  -  Jump to:" For counter = 1 to zintPages If counter = zintPage Then Response.Write " " & counter Else Response.Write " " & counter & "" End If Next 'End If End Sub Sub displayNews() 'writes newsposts to browser Call zStart_News() If Not IsArray(zobjRS) Then '# no news returned - no results for a search - just give a msg saying so and quit # Response.Write "
Sorry, no records were found matching your criteria.
" Else '-- get comments and start writing posts to document -- If CommentsPerPost <> -1 Or zblnSinglePost Then Call zStart_Comments() End If Call zWrite() End If '-- close down -- If IsArray(zobjRS) Then Erase zobjRS 'frees up memory used by news rs End If If (CommentsPerPost <> -1 Or zblnSinglePost) And IsArray(zobjRS) Then 'comments rs is open zobjRS1.Close End If Set zobjRS1 = Nothing End Sub Sub Shutdown() 'closes database connections zobjConn.Close Set zobjConn = Nothing End Sub '## end of subs/functions ## 'This is a variable of subtype String, used to hold the name of the current page. '- If this code is running on news.asp, then zstrSelf's value will be "news.asp" Dim zstrSelf zstrSelf = LCase(Request.ServerVariables("URL")) zstrSelf = Right(zstrSelf,(Len(zstrSelf) - InStrRev(zstrSelf,"/"))) Dim zblnSinglePost 'This is a variable of subtype Boolean, True is a single post has been chosen, False if normal display. zblnSinglePost = Trim(Request.QueryString("postid")) If zblnSinglePost <> "" And IsNumeric(zblnSinglePost) Then zblnSinglePost = True Else zblnSinglePost = False End If 'These variables are used in global scope, so must be dimensioned here Dim zobjRS,zobjRS1,zintPage,zintPages %>