<%@ LANGUAGE = "VBScript" %> <% Option Explicit %> <% Response.Buffer = True %> <% Response.Expires = -1 %> <% Response.CacheControl = "Public" %> <% '**************************************************************************************** '** Copyright Notice '** '** iPortalX.com '** '** Copyright 2001-2003 Drew Gauderman All Rights Reserved. '** '** This program is a paid software; you can modify (at your own risk) any part of it '** under the terms of the License that accompanies this software and use it both '** privately and commercially. '** '** All copyright notices must remain in tacked in the scripts and the '** outputted HTML. '** '** You may NOT use parts of this program in your own private work, and you may NOT '** redistribute, repackage, or sell the whole or any part of this program even '** if it is modified or reverse engineered in whole or in part without express '** permission from the author. '** '** You may not pass the whole or any part of this application off as your own work. '** '** All links to iPortalX.com and powered by logo's (if any) must remain unchanged and in place '** and must remain visible when the pages are viewed unless permission is first granted '** by the copyright holder. '** '** This program is distributed in the hope that it will be useful, '** but WITHOUT ANY WARRANTY; without even the implied warranty of '** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER '** WARRANTIES WHETHER EXPRESSED OR IMPLIED. '** '** Support is for those that have purchased it. Post support questions at: - '** http://www.iportalx.com/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** support@iportalx.com '** '**************************************************************************************** Dim rsCount Dim strNewsItem Dim intNewsTopicID Dim intNewsForumID Dim intCommentsCount Dim intTotalNumNewsEntries Dim intTotalNumNewsPages Dim intLinkPageNum Dim blnBannedIP Dim intDisplayRow Dim rsNewsCategory Dim intTotalNewsCategories Dim intNewsCategoriesPerRow Dim intNewsCategoryWidth Dim strSubject Dim intNewsID Dim intRecordPositionPageNum If bannedIP() Then 'If the user is using a banned IP then set the banned IP variable to true and active member variable to false blnBannedIP = True blnActiveMember = False End If intNewsID = Request.QueryString("NewsID") If intNewsID = "" Then intNewsID = intSiteNewsDefault End if If blnNewsCategories = False Then intNewsID = intSiteNewsDefault Else intNewsID = intNewsID End If If Clng(Request.QueryString("PagePosition")) = 0 Then intRecordPositionPageNum = 1 Else intRecordPositionPageNum = CInt(Request.QueryString("PagePosition")) End If %> <% = strWebsiteName %> - <% = strTxtNewsArchive %> <% If blnNewsCategories = True Then Dim strNewsCatName Dim intNewsCatID Dim strNewsCustomText Dim intArrayNumber Dim saryNewsCategories saryNewsCategories = Application(strApplicationName & "saryNewsCategories") Response.Write(vbCrLf & "") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & "
" & strWebsiteName & " : " & strTxtNewsCategories & "
") Response.Write(vbCrLf & "
") If IsArray(saryNewsCategories) = False OR blnUseApplicationVariables = false Then ReDim saryNewsCategories(2, 0) strSQL = "SELECT " & strDBTable & "NewsCategory.* FROM " & strDBTable & "NewsCategory " strSQL = strSQL & "ORDER BY " & strDBTable & "NewsCategory.Cat_ID ASC;" rsCommon.Open strSQL, adoCon If rsCommon.EOF Then Response.Write(vbCrLf & strTxtNoCategoriesToDisplay) Else DO UNTIL rsCommon.EOF intArrayNumber = (UBound(saryNewsCategories, 2) + 1) ReDim Preserve saryNewsCategories(2, intArrayNumber) strNewsCatName = rsCommon("Cat_name") intNewsCatID = Clng(rsCommon("Cat_ID")) saryNewsCategories(1, intArrayNumber) = strNewsCatName saryNewsCategories(2, intArrayNumber) = intNewsCatID rsCommon.MoveNext Loop End If rsCommon.Close Application(strApplicationName & "saryNewsCategories") = saryNewsCategories End If Dim intNewsCategories Response.Write(vbCrLf & "") Response.Write(vbCrLf & " ") For intNewsCategories = 1 TO UBound(saryNewsCategories, 2) strNewsCatName = saryNewsCategories(1, intNewsCategories) intNewsCatID = saryNewsCategories(2, intNewsCategories) Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Call FormatBottomTable("100%") Response.Write(vbCrLf & " ") If (intNewsCategories MOD 2 = 0) Then Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") ElseIf intNewsCategories = UBound(saryNewsCategories, 2) Then Response.Write(vbCrLf & " ") End If Next Response.Write(vbCrLf & "
") Call FormatTopTable2("100%") Response.Write(vbCrLf & "
" & strNewsCatName & "") If strNewsCustomText <> "" Then Response.Write("
" & strNewsCustomText & "") Response.Write(vbCrLf & "

") strSQL = "SELECT TOP 3 " & strDBTableTopics & ".Subject, " & strDBTableTopics & ".Topic_ID FROM " & strDBTableTopics & " " strSQL = strSQL & "WHERE " & strDBTableTopics & ".News = " & intNewsCatID & " " strSQL = strSQL & "ORDER BY " & strDBTableTopics & ".Start_date DESC;" rsCommon.Open strSQL, adoCon If rsCommon.EOF Then Response.Write(vbCrLf & "
" & strTxtNoNews & "
") Else DO UNTIL rsCommon.EOF strSubject = decodeString(rsCommon("Subject")) If Len(strSubject) > 40 Then strSubject = Left(strSubject, 40) & "... " Response.Write(" · " & strSubject & "
") rsCommon.Movenext Loop End If rsCommon.Close Response.Write(vbCrLf & "
") Response.Write(vbCrLf & "") End If %> ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & "
<% = strWebsiteName %> : <% If blnNewsCategories = True Then If intNewsID = 0 Then Response.Write(strTxtNewsArchive) Else strSQL = "SELECT " & strDbTable & "NewsCategory.* FROM " & strDbTable & "NewsCategory " strSQL = strSQL & "WHERE " & strDbTable & "NewsCategory.Cat_ID = " & intNewsID & ";" rsCommon.Open strSQL, adoCon If rsCommon.EOF Then Response.Redirect("default.asp") Else Response.Write("" & strTxtNewsArchive & " : " & rsCommon("Cat_name") & " " & strTxtNews) End If rsCommon.Close End if Else Response.Write(strTxtNewsArchive) End If Response.Write(vbCrLf & "
") Response.Write(vbCrLf & "
") Call FormatTopTable2("100%") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Dim rsArchive Set rsCount = Server.CreateObject("ADODB.Recordset") Set rsArchive = Server.CreateObject("ADODB.Recordset") 'If strDatabaseType = "SQLServer" Then ' strSQL = "EXECUTE " & strDbProc & "NewsDetails @intNewsID = " & intNewsID 'Else strSQL = "SELECT " & strDBTableTopics & ".Subject, " & strDBTableTopics & ".Start_date, " & strDBTableTopics & ".No_of_views, " & strDBTableTopics & ".Forum_ID, " & strDBTableTopics & ".News_image, " & strDbTable & "Thread.*, " & strDbTable & "Author.Username FROM " & strDBTableTopics & " " strSQL = strSQL & "INNER JOIN (" & strDbTable & "Author INNER JOIN " & strDbTable & "Thread ON " & strDbTable & "Author.Author_ID = " & strDbTable & "Thread.Author_ID) ON " & strDBTableTopics & ".Start_date = " & strDbTable & "Thread.Message_date " If intNewsID = 0 Then strSQL = strSQL & "WHERE " & strDbTable & "Thread.News > " & intNewsID & " " Else strSQL = strSQL & "WHERE " & strDbTable & "Thread.News = " & intNewsID & " " End If strSQL = strSQL & "ORDER BY " & strDbTable & "Thread.Message_date DESC;" 'End If rsArchive.CursorType = 1 rsArchive.Open strSQL, adoCon rsArchive.PageSize = intNewsItemsPerPage + 10 If rsArchive.EOF Then Response.Write("
" & strTxtSorryThereAreNoNewsItems & "
") Else rsArchive.AbsolutePage = intRecordPositionPageNum If rsArchive.EOF AND intRecordPositionPageNum > 1 Then rsArchive.AbsolutePage = 1 intTotalNumNewsEntries = rsArchive.RecordCount intTotalNumNewsPages = rsArchive.PageCount Response.Write("
" & strTxtThereAre & " " & intTotalNumNewsEntries & " " & strTxtNewsItemsIn & " " & intTotalNumNewsPages & " " & strTxtPagesAndYourAreOnPageNumber & " " & intRecordPositionPageNum & "

") For intRecordLoopCounter = 1 to intNewsItemsPerPage + 10 If rsArchive.EOF Then Exit For intNewsTopicID = Clng(rsArchive("Topic_ID")) intNewsForumID = Clng(rsArchive("Forum_ID")) intNewsID = Clng(rsArchive("Topic_ID")) strSQL = "SELECT Count(" & strDbTable & "Thread.Thread_ID) AS Comments_Count FROM " & strDbTable & "Thread " strSQL = strSQL & "WHERE " & strDbTable & "Thread.Topic_ID = " & intNewsTopicID & ";" rsCount.Open strSQL, adoCon If rsCount.EOF Then intCommentsCount = 0 Else intCommentsCount = Clng(rsCount("Comments_Count")) End If rsCount.Close %>
<% = rsArchive("Subject") %> - <% = Day(rsArchive("Start_date")) & " " & MonthName(Month(rsArchive("Start_date")), 1) & " " & Year(rsArchive("Start_date")) %>
<% = strTxtPostedBy %>: ','profile','toolbar=0,location=0,status=0,menubar=0,scrollbars=1,resizable=1,width=590,height=425')" class="smLink"><% = rsArchive("Username") %> | <% = strTxtViews %>: <% = rsArchive("No_of_views") %> | <% = strTxtComments %>: <% = intCommentsCount - 1 %>

<% rsArchive.Movenext Next End If If intRecordPositionPageNum > 1 or NOT rsArchive.EOF Then Response.Write(vbCrLF & "
") Response.Write(vbCrLf & strTxtPage & ":  ") End If If intRecordPositionPageNum > 1 Then Response.Write(vbCrLf & "<< " & strTxtPrevious & " ") End If If intRecordPositionPageNum > 1 or NOT rsArchive.EOF Then For intLinkPageNum = 1 to intTotalNumNewsPages If intLinkPageNum = intRecordPositionPageNum Then Response.Write(vbCrLf & " " & intLinkPageNum) Else Response.Write(vbCrLf & " " & intLinkPageNum & " ") End If Next End If If NOT rsArchive.EOF then Response.Write(vbCrLf & " " & strTxtNext & " >>") Response.Write(vbCrLF & "
") Else Response.Write(vbCrLF & "
") End If rsArchive.Close Set rsArchive = Nothing Set rsCount = Nothing Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Call FormatBottomTable("100%") %>
<% Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing %>