<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%> <% 'USER CONFIGURABLE OPTIONS Dim latest_post_num, newsforumid latest_post_num = 10 newsforumid = 1 'NOTE: To exclude forums from the list, please go to line 227 and follow the directions. 'Skinning and Customization: 'Just set the html color codes to your desired color...or leave the defaults. Dim sitename, tabcolor, buttonfont, buttoncolor, textcolor, welcome Const strDbTable = "tbl" sitename = "Web Wiz Guide" 'Site title tabcolor = "#5681B8" 'Tab Page Background Color buttonfont = "Microsoft San Serif" 'Choose from Microsoft San Serif, Times New Roman, Verdana or any other common font "Microsoft San Serif" is the default. buttoncolor = "#F5FFFA" 'Button Colors textcolor = "#F5FFFA" 'Text color (where applicable) welcome = "Web Wiz Forums" 'Welcome message. 'End skinning. Private Function decodeString(ByVal strInputEntry) strInputEntry = Replace(strInputEntry, "a", "a", 1, -1, 0) strInputEntry = Replace(strInputEntry, "b", "b", 1, -1, 0) strInputEntry = Replace(strInputEntry, "c", "c", 1, -1, 0) strInputEntry = Replace(strInputEntry, "d", "d", 1, -1, 0) strInputEntry = Replace(strInputEntry, "e", "e", 1, -1, 0) strInputEntry = Replace(strInputEntry, "f", "f", 1, -1, 0) strInputEntry = Replace(strInputEntry, "g", "g", 1, -1, 0) strInputEntry = Replace(strInputEntry, "h", "h", 1, -1, 0) strInputEntry = Replace(strInputEntry, "i", "i", 1, -1, 0) strInputEntry = Replace(strInputEntry, "j", "j", 1, -1, 0) strInputEntry = Replace(strInputEntry, "k", "k", 1, -1, 0) strInputEntry = Replace(strInputEntry, "l", "l", 1, -1, 0) strInputEntry = Replace(strInputEntry, "m", "m", 1, -1, 0) strInputEntry = Replace(strInputEntry, "n", "n", 1, -1, 0) strInputEntry = Replace(strInputEntry, "o", "o", 1, -1, 0) strInputEntry = Replace(strInputEntry, "p", "p", 1, -1, 0) strInputEntry = Replace(strInputEntry, "q", "q", 1, -1, 0) strInputEntry = Replace(strInputEntry, "r", "r", 1, -1, 0) strInputEntry = Replace(strInputEntry, "s", "s", 1, -1, 0) strInputEntry = Replace(strInputEntry, "t", "t", 1, -1, 0) strInputEntry = Replace(strInputEntry, "u", "u", 1, -1, 0) strInputEntry = Replace(strInputEntry, "v", "v", 1, -1, 0) strInputEntry = Replace(strInputEntry, "w", "w", 1, -1, 0) strInputEntry = Replace(strInputEntry, "x", "x", 1, -1, 0) strInputEntry = Replace(strInputEntry, "y", "y", 1, -1, 0) strInputEntry = Replace(strInputEntry, "z", "z", 1, -1, 0) strInputEntry = Replace(strInputEntry, "A", "A", 1, -1, 0) strInputEntry = Replace(strInputEntry, "B", "B", 1, -1, 0) strInputEntry = Replace(strInputEntry, "C", "C", 1, -1, 0) strInputEntry = Replace(strInputEntry, "D", "D", 1, -1, 0) strInputEntry = Replace(strInputEntry, "E", "E", 1, -1, 0) strInputEntry = Replace(strInputEntry, "F", "F", 1, -1, 0) strInputEntry = Replace(strInputEntry, "G", "G", 1, -1, 0) strInputEntry = Replace(strInputEntry, "H", "H", 1, -1, 0) strInputEntry = Replace(strInputEntry, "I", "I", 1, -1, 0) strInputEntry = Replace(strInputEntry, "J", "J", 1, -1, 0) strInputEntry = Replace(strInputEntry, "K", "K", 1, -1, 0) strInputEntry = Replace(strInputEntry, "L", "L", 1, -1, 0) strInputEntry = Replace(strInputEntry, "M", "M", 1, -1, 0) strInputEntry = Replace(strInputEntry, "N", "N", 1, -1, 0) strInputEntry = Replace(strInputEntry, "O", "O", 1, -1, 0) strInputEntry = Replace(strInputEntry, "P", "P", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Q", "Q", 1, -1, 0) strInputEntry = Replace(strInputEntry, "R", "R", 1, -1, 0) strInputEntry = Replace(strInputEntry, "S", "S", 1, -1, 0) strInputEntry = Replace(strInputEntry, "T", "T", 1, -1, 0) strInputEntry = Replace(strInputEntry, "U", "U", 1, -1, 0) strInputEntry = Replace(strInputEntry, "V", "V", 1, -1, 0) strInputEntry = Replace(strInputEntry, "W", "W", 1, -1, 0) strInputEntry = Replace(strInputEntry, "X", "X", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Y", "Y", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Z", "Z", 1, -1, 0) strInputEntry = Replace(strInputEntry, "=", "=", 1, -1, 0) strInputEntry = Replace(strInputEntry, "0", "0", 1, -1, 0) strInputEntry = Replace(strInputEntry, "1", "1", 1, -1, 0) strInputEntry = Replace(strInputEntry, "2", "2", 1, -1, 0) strInputEntry = Replace(strInputEntry, "3", "3", 1, -1, 0) strInputEntry = Replace(strInputEntry, "4", "4", 1, -1, 0) strInputEntry = Replace(strInputEntry, "5", "5", 1, -1, 0) strInputEntry = Replace(strInputEntry, "6", "6", 1, -1, 0) strInputEntry = Replace(strInputEntry, "7", "7", 1, -1, 0) strInputEntry = Replace(strInputEntry, "8", "8", 1, -1, 0) strInputEntry = Replace(strInputEntry, "9", "9", 1, -1, 0) strInputEntry = Replace(strInputEntry, "’", "'", 1, -1, 0) strInputEntry= Replace(strInputEntry, ">",">") strInputEntry = Replace(strInputEntry, "<","<") strInputEntry = Replace(strInputEntry, "&","&") 'Return decodeString = strInputEntry End Function 'Write initial lines Dim string string = "" & vbNewline string = string + "" Response.Write(string) string = _ vbNewline & "" & vbNewline & _ " " & sitename & "" & vbNewline & _ " " & tabcolor & "" & vbNewline & _ " " & buttonfont & "" & vbNewline & _ " " & buttoncolor & "" & vbNewline & _ " " & textcolor & "" & vbNewline & _ " " & welcome & "" & vbNewline & _ "" Response.Write(string) %> <% 'Gather forum home from DB Dim adoCon, rsCommon, rsCommon2, strSQL, base_url 'Create a connection odject Set adoCon = Server.CreateObject("ADODB.Connection") 'Set the connection string to the database adoCon.connectionstring = strCon 'Set an active connection to the Connection object adoCon.Open 'Intialise the ADO recordset object Set rsCommon = Server.CreateObject("ADODB.Recordset") 'Query the database strSQL = "SELECT forum_path AS url FROM tblConfiguration;" rsCommon.Open strSQL, adoCon base_url = rsCommon("url") & "/" 'Close it off rsCommon.close 'Stats 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT tblForum.No_of_topics, tblForum.No_of_posts FROM tblForum;" 'Query the database rsCommon.Open strSQL, adoCon 'Get the number of topics posts and forums Do While NOT rsCommon.EOF 'Count the number of topics totalthreads = totalthreads + CLng(rsCommon("No_of_topics")) 'Count the number of posts totalreplies = totalreplies + CLng(rsCommon("No_of_posts")) 'Move to the next record rsCommon.MoveNext Loop totalposts = totalreplies + totalthreads 'Clean up rsCommon.Close 'Get the total member count strSQL = "SELECT COUNT(Author_ID) AS members FROM tblAuthor;" 'Query the database rsCommon.Open strSQL, adoCon members_num = CLng(rsCommon("members")) 'Clean up rsCommon.Close string = _ vbNewline & "" & vbNewline & _ " " & totalposts & "" & vbNewline & _ " " & totalthreads & "" & vbNewline & _ " " & totalreplies & "" & vbNewline & _ " " & members_num & "" & vbNewline & _ "" Response.Write(string) 'News Dim i, n, profile_link, member_name, post_date, topic_title, post, comments, view_all_link, topic_id, author_id 'Select the top 10 from news forum strSQL = "SELECT Top 10 tblTopic.Subject, tblTopic.Start_date, tblTopic.Topic_ID FROM tblTopic WHERE tblTopic.Forum_ID = " & newsforumid & " ORDER BY tblTopic.Start_date DESC;" rsCommon.Open strSQL, adoCon 'Need a secound rs for loop (create outside loop so it only needs to be created once for better performance) 'Intialise the ADO recordset object Set rsCommon2 = Server.CreateObject("ADODB.Recordset") 'Loop through recordset till end of records Do While NOT rsCommon.EOF topic_title = rsCommon("Subject") post_date = rsCommon("Start_date") topic_id = rsCommon("Topic_ID") strSQL = "SELECT tblThread.Message, tblThread.Author_ID, tblAuthor.Username " & _ "FROM tblThread, tblAuthor " & _ "WHERE tblThread.Author_ID=tblAuthor.Author_ID AND tblThread.Topic_ID = " & topic_id & ";" 'Set the cursor type to 1 to count the number of returned records rsCommon2.CursorType = 1 rsCommon2.Open strSQL, adoCon post = Trim(Mid(rsCommon2("Message"),1,1000)) & "......" author_id = rsCommon2("Author_ID") comments = CLng(rsCommon2.RecordCount) member_name = rsCommon2("Username") 'Close rs rsCommon2.Close profile_link = base_url & "pop_up_profile.asp?PF=" & author_id view_all_link = base_url & "forum_posts.asp?TID=" & topic_id & "&PN=1000" 'Character replacement profile_link= decodeString(profile_link) member_name= decodeString(member_name) topic_title= decodeString(topic_title) post = decodeString(post) view_all_link= decodeString(view_all_link) string = _ vbNewline & "" & vbNewline & _ " " & profile_link & "" & vbNewline & _ " " & member_name & "" & vbNewline & _ " " & post_date & "" & vbNewline & _ " " & topic_title & "" & vbNewline & _ " " & post & "" & vbNewline & _ " " & comments & "" & vbNewline & _ " " & view_all_link & "" & vbNewline & _ "" Response.Write(string) rsCommon.MoveNext Loop 'Clean up rsCommon.Close 'Posts Dim last_poster_name, last_post_date 'If you wish to have ALL forums checked by Extenshun, leave the default: '"Topic_ID AS topic_id FROM tblTopic WHERE Forum_ID <> 0 ORDER BY Last_entry_date DESC" 'If you have forums that you do not wish to have checked, look up the forum ID from the database and do something like this; '"Topic_ID AS topic_id FROM tblTopic WHERE Forum_ID <> 13 AND Forum_ID <> 7 AND Forum_ID <> 8 ORDER BY Last_entry_date DESC" 'Where 13, 7, and 8 are forum IDs you do NOT want to include. '..and so on. strSQL = "SELECT TOP " & latest_post_num & " tblTopic.Subject, tblTopic.Last_entry_date, tblTopic.Start_date, tblTopic.Topic_ID " & _ "FROM tblTopic WHERE tblTopic.Forum_ID <> 0 ORDER BY Last_entry_date DESC;" rsCommon.Open strSQL, adoCon 'Loop through recordset Do while NOT rsCommon.EOF topic_title = rsCommon("Subject") post_date = rsCommon("Start_date") topic_id = rsCommon("Topic_ID") last_post_date = rsCommon("Last_entry_date") strSQL = "SELECT tblThread.Author_ID, tblAuthor.Username FROM tblThread, tblAuthor " & _ "WHERE tblThread.Author_ID=tblAuthor.Author_ID AND Topic_ID = " & topic_id & " ORDER BY tblThread.Message_date DESC;" rsCommon2.Open strSQL, adoCon author_id = rsCommon2("Author_ID") last_poster_name = rsCommon2("Username") rsCommon2.Close view_all_link = base_url & "forum_posts.asp?TID=" & topic_id & "&PN=1000" 'Character replacement last_poster_name= decodeString(last_poster_name) topic_title = decodeString(topic_title) view_all_link = decodeString(view_all_link) string = _ vbNewline & "" & vbNewline & _ " " & last_poster_name & "" & vbNewline & _ " " & last_post_date & "" & vbNewline & _ " " & topic_title & "" & vbNewline & _ " " & view_all_link & "" & vbNewline & _ "" Response.Write(string) rsCommon.MoveNext Loop 'Clean up rsCommon.close 'Secound rs no longer needed so release server object Set rsCommon2 = Nothing 'Active users strSQL = "SELECT tblActiveUser.Author_ID, tblAuthor.Username FROM tblActiveUser, tblAuthor " & _ "WHERE tblActiveUser.Author_ID=tblAuthor.Author_ID ORDER BY tblAuthor.Username ASC;" rsCommon.Open strSQL, adoCon Do While NOT rsCommon.EOF author_id = rsCommon("Author_ID") member_name = rsCommon("Username") profile_link = base_url & "pop_up_profile.asp?PF=" & author_id 'Character replacement member_name= decodeString(member_name) profile_link= decodeString(profile_link) string = _ vbNewline & "" & vbNewline & _ " " & member_name & "" & vbNewline & _ " " & profile_link & "" & vbNewline & _ "" Response.Write(string) rsCommon.MoveNext Loop 'Clean up rsCommon.Close Set rsCommon = nothing adoCon.close set adoCon=nothing string = vbNewline & "" Response.Write(string) %>