[MOD] Google Sitemap for SQL v8.04

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="functions/functions_date_time_format.asp" -->
<%

'************************************************

'****** Dynamic Google SiteMap for WWF v8.04 SQL*******

'******* written by Kaan DOGAN (aka Superlative)********

'**************** www.knowhow.gen.tr**************

'************************************************
'Dimension variables
Dim intRecordPositionPageNum
Dim intTotalRecordsPages 'Holds the total number of pages
Dim intStartPosition  'Holds the start poition for records to be shown
Dim intEndPosition  'Holds the end poition for records to be shown
Dim sarryForums   'Holds the recordset array for all the categories and forums
Dim sarryTopics   'Holds the topics to display
Dim saryMemebrStats  'Holds the member stats
Dim intForumID   'Holds the forum ID number
Dim strCategory   'Holds the category name
Dim intCatID   'Holds the id for the category
Dim strForumName  'Holds the forum name
Dim strForumDiscription  'Holds the forum description
Dim strForumPassword  'Holds the forum password if there is one
Dim lngNumberOfTopics  'Holds the number of topics in a forum
Dim lngNumberOfPosts  'Holds the number of Posts in the forum
Dim lngTotalNumberOfTopics 'Holds the total number of topics in a forum
Dim lngTotalNumberOfPosts 'Holds the total number of Posts in the forum
Dim intNumberofForums  'Holds the number of forums
Dim lngLastEntryMeassgeID 'Holds the message ID of the last entry
Dim dtmLastEntryDate  'Holds the date of the last entry to the forum
Dim strLastEntryUser  'Holds the the username of the user who made the last entry
Dim lngLastEntryUserID  'Holds the ID number of the last user to make and entry
Dim dtmLastEntryDateAllForums 'Holds the date of the last entry to all fourms
Dim strLastEntryUserAllForums 'Holds the the username of the user who made the last entry to all forums
Dim lngLastEntryUserIDAllForums 'Holds the ID number of the last user to make and entry to all forums
Dim blnForumLocked  'Set to true if the forum is locked
Dim intForumColourNumber 'Holds the number to calculate the table row colour
Dim blnHideForum  'Set to true if this is a hidden forum
Dim intCatShow   'Holds the ID number of the category to show if only showing one category
Dim intActiveUsers  'Holds the number of active users
Dim intActiveGuests  'Holds the number of active guests
Dim intActiveMembers  'Holds the number of logged in active members
Dim strMembersOnline  'Holds the names of the members online
Dim intSubForumID  'Holds the sub forum ID number
Dim strSubForumName  'Holds the sub forum name
Dim strSubForums  'Holds if there are sub forums
Dim dtmLastSubEntryDate  'Holds the date of the last entry to the forum
Dim strLastSubEntryUser  'Holds the the username of the user who made the last entry
Dim lngLastSubEntryUserID 'Holds the ID number of the last user to make and entry
Dim lngSubForumNumberOfPosts 'Holds the number of posts in the subforum
Dim lngSubForumNumberOfTopics 'Holds the number of topics in the subforum
Dim intTotalRecords  'Holds the number of records
Dim intCurrentRecord  'Holds the current record position
Dim intTempRecord  'Holds a temporary record position for looping through records for any checks
Dim blnSubRead   'Holds if the user has entry to the sub forum
Dim lngNoOfMembers  'Holds the number of forum members
Dim intArrayPass  'Active users array counter
Dim strBirthdays  'String containing all those with birtdays today
Dim dtmNow   'Now date with off-set
Dim intBirtdayLoopCounter 'Holds the bitrhday loop counter
Dim intLastForumEntryID  'Holds the last forum ID for the last entry for link in forum stats
Dim intTotalViewingForum 'Holds the number of people viewing the forum, including sub forums
Dim z

'Initialise variables
lngTotalNumberOfTopics = 0
lngTotalNumberOfPosts = 0
intNumberofForums = 0
intForumColourNumber = 0
intActiveMembers = 0
intActiveGuests = 0
intActiveUsers = 0
intTotalRecords = 0
lngNoOfMembers = 0
intBirtdayLoopCounter = 0
z= 0

'Set the content type for feed
Response.ContentType = "application/xml"
%><?xml version="1.0" encoding="UTF-8" ?>
<urlset xmlns="http://www.google.com/schemas/sitemap/0.84"><%

'Read the various categories, forums, and permissions from the database in one hit for extra performance
'Initalise the strSQL variable with an SQL statement to query the database
strSQL = "" & _
"SELECT " & strDbTable & "Category.Cat_ID, " & strDbTable & "Category.Cat_name, " & strDbTable & "Forum.Forum_ID, " & strDbTable & "Forum.Sub_ID, " & strDbTable & "Forum.Forum_name, " & strDbTable & "Forum.Forum_description, " & strDbTable & "Forum.No_of_topics, " & strDbTable & "Forum.No_of_posts, " & strDbTable & "Author.Username, " & strDbTable & "Forum.Last_post_author_ID, " & strDbTable & "Forum.Last_post_date, " & strDbTable & "Forum.Password, " & strDbTable & "Forum.Locked, " & strDbTable & "Forum.Hide, " & strDbTable & "Permissions.View_Forum " & _
"FROM " & strDbTable & "Category" & strDBNoLock & ", " & strDbTable & "Forum" & strDBNoLock & ", " & strDbTable & "Permissions" & strDBNoLock & ", " & strDbTable & "Author" & strDBNoLock & " " & _
"WHERE " & strDbTable & "Category.Cat_ID = " & strDbTable & "Forum.Cat_ID " & _
 "AND " & strDbTable & "Forum.Forum_ID = " & strDbTable & "Permissions.Forum_ID " & _
 "AND " & strDbTable & "Forum.Last_post_author_ID = " & strDbTable & "Author.Author_ID " & _
 "AND (" & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & " OR " & strDbTable & "Permissions.Group_ID = " & intGroupID & ") " & _
"ORDER BY " & strDbTable & "Category.Cat_order, " & strDbTable & "Forum.Forum_Order, " & strDbTable & "Permissions.Author_ID DESC;"

'Set error trapping
On Error Resume Next
 
'Query the database
rsCommon.Open strSQL, adoCon

'If an error has occured write an error to the page
If Err.Number <> 0 Then Call errorMsg("An error has occured while executing SQL query on database.", "get_forum_data", "default.asp")
   
'Disable error trapping
On Error goto 0

'Place the recordset into an array
If NOT rsCommon.EOF Then
 sarryForums = rsCommon.GetRows()
 intTotalRecords = Ubound(sarryForums,2) + 1
End If

'Close the recordset
rsCommon.Close

'SQL Query Array Look Up table
'0 = Cat_ID
'1 = Cat_name
'2 = Forum_ID
'3 = Sub_ID
'4 = Forum_name
'5 = Forum_description
'6 = No_of_topics
'7 = No_of_posts
'8 = Last_post_author
'9 = Last_post_author_ID
'10 = Last_post_date
'11 = Password
'12 = Locked
'13 = Hide
'14 = Read

'Check there are categories to display
If intTotalRecords = 0 Then

'Else there the are categories so write the HTML to display categories and the forum names and a discription
Else 

 'Loop round to show all the categories and forums
 Do While intCurrentRecord <= Ubound(sarryForums,2)
 
  
  'Loop through the array looking for forums that are to be shown
  'if a forum is found to be displayed then show the category and the forum, if not the category is not displayed as there are no forums the user can access
  Do While intCurrentRecord <= Ubound(sarryForums,2)
  
   'Read in details
   blnHideForum = CBool(sarryForums(13,intCurrentRecord))
   blnRead = CBool(sarryForums(14,intCurrentRecord))
     
   'If this forum is to be shown then leave the loop and display the cat and the forums
   If blnHideForum = False OR blnRead = True Then Exit Do
   
   'Move to next record
   intCurrentRecord = intCurrentRecord + 1
  Loop
    
  'If we have run out of records jump out of loop
  If intCurrentRecord > Ubound(sarryForums,2) Then Exit Do
 
 
  'Read in the details from the array of this category
  intCatID = CInt(sarryForums(0,intCurrentRecord))
  strCategory = sarryForums(1,intCurrentRecord)
z= z + 1  
%><url>
  <loc><%="http://www.knowhow.gen.tr/forum/default.asp?C=" & intCatID%></loc>
  <changefreq>daily</changefreq>
  <priority>0.5</priority>
 </url><%  
   
  'If the user only wants to see one category, only display the forums for that category
  If intCatShow = intCatID OR intCatShow = 0 Then
   
   'Loop round to display all the forums for this category
   Do While intCurrentRecord <= Ubound(sarryForums,2)
    
    'Initialise variables
    strSubForums = ""
   
   
    'Read in the details for this forum
    intForumID = CInt(sarryForums(2, intCurrentRecord))
    intSubForumID = CInt(sarryForums(3, intCurrentRecord))
z= z + 1 
%><url>
  <loc><%="http://www.knowhow.gen.tr/forum/forum_topics.asp?FID=" & intForumID%></loc>
  <changefreq>daily</changefreq>
  <priority>0.5</priority>
 </url><%
   
 
     'Display if this forum has any subforums
     '***************************************
     
     'Initilise variables
     intTempRecord = 0
     
     'Loop round to read in any sub forums in the stored array recordset
     Do While intTempRecord <= Ubound(sarryForums,2)
     
     
      'Becuase the member may have an individual permission entry in the permissions table for this forum,
      'it maybe listed twice in the array, so we need to make sure we don't display the same forum twice
      If intSubForumID = CInt(sarryForums(2,intTempRecord)) Then intTempRecord = intTempRecord + 1
       
      'If there are no records left exit loop
      If intTempRecord > Ubound(sarryForums,2) Then Exit Do
    
      'If this is a subforum of the main forum then get the details
      If CInt(sarryForums(3,intTempRecord)) = intForumID Then
             
      
       'Read in sub forum details from the database
       intSubForumID = CInt(sarryForums(2,intTempRecord))
z= z + 1 
       
%><url>
  <loc><%="http://www.knowhow.gen.tr/forum/forum_topics.asp?FID=" & intSubForumID%></loc>
  <changefreq>daily</changefreq>
  <priority>0.5</priority>
 </url><%

      End If
      
    'Move to next record
    intTempRecord = intTempRecord + 1
   Loop

 

    'Move to the next database record
    intCurrentRecord = intCurrentRecord + 1
    
    
    'If there are more records in the array to display then run some test to see what record to display next and where    
    If intCurrentRecord <= Ubound(sarryForums,2) Then

     'Becuase the member may have an individual permission entry in the permissions table for this forum,
     'it maybe listed twice in the array, so we need to make sure we don't display the same forum twice
     If intForumID = CInt(sarryForums(2,intCurrentRecord)) Then intCurrentRecord = intCurrentRecord + 1
     
     'If there are no records left exit loop
     If intCurrentRecord > Ubound(sarryForums,2) Then Exit Do
     
     'If this is a subforum jump to the next record, unless we have run out of forums
     Do While CInt(sarryForums(3,intCurrentRecord)) > 0
      
      'Go to next record
      intCurrentRecord = intCurrentRecord + 1
      
      'If we have run out of records jump out of loop
      If intCurrentRecord > Ubound(sarryForums,2) Then Exit Do
     Loop
     
     'If there are no records left exit loop
     If intCurrentRecord > Ubound(sarryForums,2) Then Exit Do
     
     'See if the next forum is in a new category, if so jump out of this loop to display the next category
     If intCatID <> CInt(sarryForums(0,intCurrentRecord)) Then Exit Do
    End If
   
   'Loop back round to display next forum
   Loop
  
  
  'Else we are not displaying forums in this category so we need to move to the next category in the array
  Else
  
   'Loop through the forums array till we get to the next category
   Do While CInt(sarryForums(0,intCurrentRecord)) = intCatID
     
    'Go to next record
    intCurrentRecord = intCurrentRecord + 1
     
    'If we have run out of records jump out of forums loop into the category loop
    If intCurrentRecord > Ubound(sarryForums,2) Then Exit Do
   Loop 
  End If

  
 'Loop back round for next category
 Loop
End If

'TOPIC'ler listeleniyor
Dim k,sayikayit

rsCommon.Open "Select count(*) as toplam from tblTopic", adoCon
sayikayit = rsCommon("toplam")
rsCommon.Close

strSQL = "Select * from tblTopic order by Topic_ID DESC"

'Set error trapping
On Error Resume Next
 
'Query the database
rsCommon.Open strSQL, adoCon

'If an error has occured write an error to the page
If Err.Number <> 0 Then Call errorMsg("An error has occured while executing SQL query on database.", "get_forum_data", "default.asp")
   
'Disable error trapping
On Error goto 0

'Place the recordset into an array
If NOT rsCommon.EOF Then
'Do....While Loop to loop through the recorset to display the forum topics
 For k=1 to sayikayit
z= z + 1

 %><url>
  <loc><%="http://www.knowhow.gen.tr/forum/forum_posts.asp?TID=" & rsCommon("Topic_ID")%></loc>
  <changefreq>daily</changefreq>
  <priority>0.5</priority>
</url><%

If z = 50000 then exit for

  'Move to the next record
  rsCommon.Movenext
 
 Next 
End If

rsCommon.Close
%>
</urlset>