<% = strMainForumName %>

<% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by email ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Global '--------------------------------------------------------------------------------- Const strTxtWelcome = "Welcome" Const strTxtAllForums = "All Forums" Const strTxtTopics = "Topics" Const strTxtPosts = "Posts" Const strTxtLastPost = "Last Post" Const strTxtPostPreview = "Post Preview" Const strTxtAt = "at" Const strTxtBy = "By" Const strTxtOn = "on" Const strTxtProfile = "Profile" Const strTxtSearch = "Search" Const strTxtQuote = "Quote" Const strTxtVisit = "Visit" Const strTxtView = "View" Const strTxtHome = "Home" Const strTxtHomepage = "Homepage" Const strTxtEdit = "Edit" Const strTxtDelete = "Delete" Const strTxtEditProfile = "Edit Profile" Const strTxtLogOff = "Logout" Const strTxtRegister = "Register" Const strTxtLogin = "Login" Const strTxtMembersList = "Display List of Forum Members" Const strTxtForumLocked = "Forum Locked" Const strTxtSearchTheForum = "Search The Forum" Const strTxtPostReply = "Post Reply" Const strTxtNewTopic = "Post New Topic" Const strTxtCloseWindow = "Close Window" Const strTxtNoForums = "There are no Forum's to display" Const strTxtReturnToDiscussionForum = "Return to the Discussion Forum" Const strTxtMustBeRegistered = "You must be a registered user in order to use this forum." Const strClickHereIfNotRegistered = "Click here if you are not a registered user" Const strTxtResetForm = "Reset Form" Const strTxtClearForm = "Clear Form" Const strTxtYes = "Yes" Const strTxtNo = "No" Const strTxtForumLockedByAdmim = "Sorry, this function has been disabled.
This Forum has been locked by the Forum Administrator." Const strTxtRequiredFields = "Indicates required fields" Const strTxtForumJump = "Forum Jump" Const strTxtSelectForum = "Select Forum" 'Global Error '--------------------------------------------------------------------------------- Const strTxtErrorDisplayLine = "_______________________________________________________________" Const strTxtErrorDisplayLine1 = "The form has not been submitted because there are problem(s) with the form." Const strTxtErrorDisplayLine2 = "Please correct the problem(s) and re-submit the form." Const strTxtErrorDisplayLine3 = "The following field(s) need to be corrected: -" Const strResetFormConfirm = "Are you sure you want to reset the form?" 'default.asp '--------------------------------------------------------------------------------- Const strTxtCookies = "Cookies and JavaScript must be enabled on your web browser in order to use this forum" Const strTxtForum = "Forum" Const strTxtLatestForumPosts = "Latest Forum Posts" Const strTxtForumStatistics = "Forum Statistics" Const strTxtNoForumPostMade = "There have been no Forum Posts" Const strTxtThereAre = "There are" Const strTxtPostsIn = "Posts in" Const strTxtTopicsIn = "Topics in" Const strTxtLastPostOn = "Last Post on" Const strTxtLastPostBy = "Last Post by" Const strTxtForumMembers = "Forum Members" Const strTxtTheNewestForumMember = "The Newest Forum Member is" 'forum_topics.asp '--------------------------------------------------------------------------------- Const strTxtThreadStarter = "Topic Starter" Const strTxtReplies = "Replies" Const strTxtViews = "Views" Const strTxtDeleteTopicAlert = "Are you sure you want to delete this topic?" Const strTxtDeleteTopic = "Delete Topic" Const strTxtNextTopic = "Next Topic" Const strTxtLastTopic = "Last Topic" Const strTxtShowTopics = "Show Topics" Const strTxtNoTopicsToDisplay = "There are no message's posted in this forum in the last" Const strTxtAll = "All" Const strTxtLastWeek = "from the Last Week" Const strTxtLastTwoWeeks = "from the Two Weeks" Const strTxtLastMonth = "from the Last Month" Const strTxtLastTwoMonths = "from the Last Two Months" Const strTxtLastSixMonths = "from the Last Six Months" Const strTxtLastYear = "from the Year" 'forum_posts.asp '--------------------------------------------------------------------------------- Const strTxtLocation = "Location" Const strTxtJoined = "Joined" Const strTxtForumAdministrator = "Forum Administrator" Const strTxtForumModerator = "Forum Moderator" Const strTxtDeletePostAlert = "Are you sure you want to delete this post?" Const strTxtEditPost = "Edit Post" Const strTxtDeletePost = "Delete Post" Const strTxtSearchForPosts = "Search for other posts by" Const strTxtSubjectFolder = "Subject" Const strTxtPrintVersion = "Printable version" Const strTxtEmailTopic = "Email this topic" Const strTxtSorryNoReply = "Sorry, you can NOT post a reply." Const strTxtForumMembershipSespended = "Your Forum Membership is not active!" Const strTxtThisForumIsLocked = "This forum has been locked by a forum administrator." Const strTxtPostAReplyRegister = "If you wish to post a reply to this topic you must first" Const strTxtNeedToRegister = "If you are not already registered you must first" Const strTxtSmRegister = "register" Const strTxtNoThreads = "There are no posts in the database relating to this topic" Const strTxtNotGiven = "Not Given" Const strTxtNoMessageError = "Message \t\t- Enter a Message to post" 'search_form.asp '--------------------------------------------------------------------------------- Const strTxtSearchFormError = "Search For\t- Enter something to search for" 'search.asp '--------------------------------------------------------------------------------- Const strTxtSearchResults = "Search Results" Const strTxtYourSearchFor = "Your search for" Const strTxtHasFound = "has found" Const strTxtResults = "results" Const strTxtNoSearchResults = "Sorry, your search found no results" Const strTxtClickHereToRefineSearch = "Click here to refine your search" Const strTxtSearchFor = "Search For" Const strTxtSearchIn = "Search In" Const strTxtSearchOn = "Search On" Const strTxtAllWords = "All Words" Const strTxtAnyWords = "Any Words" Const strTxtPhrase = "Phrase" Const strTxtTopicSubject = "Topic Subject" Const strTxtMessageBody = "Message Body" Const strTxtAuthor = "Author" Const strTxtSearchForum = "Search Forum" Const strTxtSortResultsBy = "Sort Results By" Const strTxtLastPostTime = "Last Post Time" Const strTxtTopicStartDate = "Topic Start Date" Const strTxtSubjectAlphabetically = "Subject Alphabetically" Const strTxtNumberViews = "Number of Views" Const strTxtStartSearch = "Start Search" 'printer_friendly_posts.asp '--------------------------------------------------------------------------------- Const strTxtPrintPage = "Print Page" Const strTxtPrintedFrom = "Printed From" Const strTxtForumName = "Forum Name" Const strTxtForumDiscription = "Forum Discription" Const strTxtURL = "URL" Const strTxtPrintedDate = "Printed Date" Const strTxtTopic = "Topic" Const strTxtPostedBy = "Posted By" Const strTxtDatePosted = "Date Posted" 'emoticons.asp '--------------------------------------------------------------------------------- Const strTxtEmoticonSmilies = "Emoticons" Const strTxtClickOnEmoticonToAdd = "Click on the emoticon you would like to add to your message." 'login.asp '--------------------------------------------------------------------------------- Const strTxtSorryUsernamePasswordIncorrect = "Sorry the Username or Password entered is incorrect." Const strTxtPleaseTryAgain = "Please try again." Const strTxtUsername = "Username" Const strTxtPassword = "Password" Const strTxtLoginUser = "Forum Login" Const strTxtClickHereForgottenPass = "Forgotten your password?" Const strTxtErrorUsername = "Username \t- Enter your Forum Username" Const strTxtErrorPassword = "Password \t- Enter your Forum Password" 'forgotten_password.asp '--------------------------------------------------------------------------------- Const strTxtForgottenPassword = "Forgotten Password" Const strTxtNoRecordOfUsername = "Sorry, the email address entered does not match the one listed for that username." Const strTxtNoEmailAddressInProfile = "Sorry, your profile does not contain an email address.
Your new password can not be emailed to you." Const strTxtReregisterForForum = "You will need to re-register to use the forum." Const strTxtPasswordEmailToYou = "Your new password has been emailed to you." Const strTxtPleaseEnterYourUsername = "Please enter your username and the email address in the boxes below.
Your new password will then be sent to the email address in your profile." Const strTxtValidEmailRequired = "If your forum profile does not contain a valid email address for you then you will have to re-register to use the forum." Const strTxtEmailPassword = "Email Password" Const strTxtEmailPasswordRequest = "A Forgotten Password request has been made for a new password to be emailed to you for the Forum, " Const strTxtEmailPasswordRequest2 = "Your new password is: -" Const strTxtEmailPasswordRequest3 = "To go to the forum now click on the link below: -" 'forum_password_form.asp '--------------------------------------------------------------------------------- Const strTxtForumLogin = "Forum Login" Const strTxtErrorEnterPassword = "Password \t- Enter a Password to use this Forum" Const strTxtPasswordRequiredForForum = "This is a private forum and requires that you enter a forum password to proceed." Const strTxtForumPasswordIncorrect = "Sorry the Password entered is incorrect." Const strTxtAutoLogin = "Auto Login" Const strTxtLoginToForum = "Login To Forum" 'profile.asp '--------------------------------------------------------------------------------- Const strTxtNoUserProfileFound = "Sorry no profile can be found for this user" Const strTxtRegisteredToViewProfile = "Sorry, you must be a registered user to view profiles." Const strTxtMemberNo = "Member No." Const strTxtEmail = "Email Address" Const strTxtPrivate = "Private" 'post_message_form.asp '--------------------------------------------------------------------------------- Const strTxtPostNewTopic = "Post New Topic" Const strTxtErrorTopicSubject = "Subject \t\t- Enter a Subject for your new Topic" Const strTxtForumMemberSuspended = "Sorry, this function is disabled as your Forum Membership is not activate!" 'edit_post.asp '--------------------------------------------------------------------------------- Const strTxtNoPermissionToEditPost = "Sorry, you do not have permission to edit this post!" Const strTxtReturnForumTopic = "Return to Forum Topic" 'email_topic.asp '--------------------------------------------------------------------------------- Const strTxtEmailTopicToFriend = "Email Topic To a Friend" Const strTxtFriendSentEmail = "Your Friend has been sent the email" Const strTxtFriendsName = "Friends Name" Const strTxtFriendsEmail = "Friends Email" Const strTxtYourName = "Your Name" Const strTxtYourEmail = "Your Email" Const strTxtSendEmail = "Send Email" Const strTxtMessage = "Message" Const strTxtEmailFriendMessage = "I thought you might be interested in a post on" Const strTxtFrom = "from" Const strTxtErrorFrinedsName = "Friends Name \t- Enter your Friends Name" Const strTxtErrorFriendsEmail = "Friends Email \t- Enter a valid email address for your friend" Const strTxtErrorYourName = "Your Name \t- Enter your Name" Const strTxtErrorYourEmail = "Your Email \t- Enter your valid email address" Const strTxtErrorEmailMessage = "Message \t- Enter a message for your friend" 'members.asp '--------------------------------------------------------------------------------- Const strTxtForumMembersList = "Forum Members List" Const strTxtMemberSearch = "Member Search" Const strTxtForumMembersOn = "forum members on" Const strTxtPageYouAerOnPage = "pages and you are on page number" Const strTxtYourSearchMembersFound = "Your search of the forum members found" Const strTxtMatches = "matches" Const strTxtUsernameAlphabetically = "Username Alphabetically" Const strTxtNewForumMembersFirst = "New Forum Members First" Const strTxtOldForumMembersFirst = "Old Forum Members First" Const strTxtLocationAlphabetically = "Location Alphabetically" Const strTxtRegistered = "Registered" Const strTxtSend = "Send" Const strTxtPrivateEmail = "a private email" Const strTxtNext = "Next" Const strTxtPrevious = "Prev" Const strTxtPage = "Page" Const strTxtErrorMemberSerach = "Member Search\t- Enter a Members Username to search for" 'message_form.asp '--------------------------------------------------------------------------------- Const strTxtTextFormat = "Text Format" Const strTxtPreviewPost = "Preview Post" Const strTxtMode = "Mode" Const strTxtPrompt = "Prompt" Const strTxtBasic = "Basic" Const strTxtAddEmailLink = "Add Email Link" Const strTxtList = "List" Const strTxtCentre = "Centre" Const strTxtEnterBoldText = "Enter text you want formatted in Bold" Const strTxtEnterItalicText = "Enter text you want formatted in Italic" Const strTxtEnterUnderlineText = "Enter text you want Underlined" Const strTxtEnterCentredText = "Enter text you want Centred" Const strTxtEnterHyperlinkText = "Enter the on screen display text for the Hyperlink" Const strTxtEnterHeperlinkURL = "Enter the URL address to create Hyperlink to" Const strTxtEnterEmailText = "Enter the on screen display text for the email address" Const strTxtEnterEmailMailto = "Enter the email address to link to" Const strTxtEnterImageURL = "Enter the web address of the image" Const strTxtEnterTypeOfList = "Type of list" Const strTxtEnterEnter = "Enter" Const strTxtEnterNumOrBlankList = "for numbered or leave blank for bulleted" Const strTxtEnterListError = "ERROR! Please enter" Const strEnterLeaveBlankForEndList = "List item Leave blank to end list" 'IE_message_form.asp '--------------------------------------------------------------------------------- Const strTxtCut = "Cut" Const strTxtCopy = "Copy" Const strTxtPaste = "Paste" Const strTxtBold = "Bold" Const strTxtItalic = "Italic" Const strTxtUnderline = "Underline" Const strTxtLeftJustify = "Left Justify" Const strTxtCentrejustify = "Centre Justify" Const strTxtRightJustify = "Right Justify" Const strTxtUnorderedList = "Unordered List" Const strTxtOutdent = "Outdent" Const strTxtIndent = "Indent" Const strTxtAddHyperlink = "Add Hyperlink" Const strTxtAddImage = "Add Image" Const strTxtJavaScriptEnabled = "JavaScript must be enabled on your web browser for you to post a message in the forum!" Const strTxtShowSignature = "Show Signature" Const strTxtEmailNotify = "Email Notify me of Replies" Const strTxtUpdatePost = "Update Post" Const strTxtFontColour = "Colour" 'register.asp '--------------------------------------------------------------------------------- Const strTxtRegisterNewUser = "Register New User" Const strTxtProfileUsernameLong = "This is the name displayed when you use the forum" Const strTxtRetypePassword = "Retype Password" Const strTxtProfileEmailLong = "Not required, but useful if you wish to be notified when someone answers one of your post's or if you lose your password" Const strTxtShowHideEmail = "Show my Email Address" Const strTxtShowHideEmailLong = "Hide your email address if you want it kept private from other users" Const strTxtSelectCountry = "Select Country" Const strTxtProfileAutoLogin = "Automatically log me in when I return to the Forum" Const strTxtSignature = "Signature" Const strTxtSignatureLong = "Enter a signature that you would like shown at the bottom of your Forum Posts" Const strTxtErrorUsernameChar = "Username \t- Your Username must be at least 4 characters" Const strTxtErrorPasswordChar = "Password \t- Your Password must be at least 4 characters" Const strTxtErrorPasswordNoMatch = "Password Error\t- The passwords entered do not match" Const strTxtErrorValidEmail = "Email\t\t- Enter your valid email address" Const strTxtErrorValidEmailLong = "If you don't want to enter your email address then leave the email field blank" Const strTxtErrorNoEmailToShow = "You can not show your email address if you haven\'t entered one!" Const strTxtErrorSignatureToLong = "Signature \t- Your signature has to many characters" Const strTxtUpdateProfile = "Update Profile" Const strTxtUsrenameGone = "Sorry the Username you requested is already taken.\n\nPlease choose another Username." Const strTxtEmailThankYouForRegistering = "Thank-you for taking the time to register to use the" Const strTxtEmailYouCanNowUseTheForumAt = "Your login details can be found below and now you have registered for a new account you can post new messages and reply to existing ones on the" Const strTxtEmailForumAt = "Forum at" Const strTxtEmailToThe = "to the" 'register_new_user.inc '--------------------------------------------------------------------------------- Const strTxtEmailAMeesageHasBeenPosted = "A message has been posted in the forum on" Const strTxtEmailClickOnLinkBelowToView = "To view and/or reply to the post then click on the link below" Const strTxtEmailAMeesageHasBeenPostedOnForumNum = "A message has been posted in the forum number" 'registration_rules.asp '--------------------------------------------------------------------------------- Const strTxtForumRulesAndPolicies = "Forum Rules and Policies" Const srtTxtAccept = "Accept" Const strTxtCancel = "Cancel" 'New from version 6 '--------------------------------------------------------------------------------- Const strTxtHi = "Hi" Const strTxtInterestingForumPostOn = "Interesting Forum post on" Const strTxtForumLostPasswordRequest = "Forum Lost Password Request" Const strTxtLockForum = "Lock Forum" Const strTxtLockedTopic = "Closed Topic" Const strTxtUnLockTopic = "Un-Lock Topic" Const strTxtTopicLocked = "Topic Closed" Const strTxtUnForumLocked = "Un-Lock Forum" Const strTxtThisTopicIsLocked = "This topic is closed." Const strTxtThatYouAskedKeepAnEyeOn = "that you asked us to keep an eye on." Const strTxtTheTopicIsNowDeleted = "The Topic has now been Deleted." Const strTxtOf = "of" Const strTxtTheTimeNowIs = "The time now is" Const strTxtYouLastVisitedOn = "You last visited on" Const strTxtSendMsg = "Send PM" Const strTxtSendPrivateMessage = "Send Private Message" Const strTxtActiveUsers = "Active Users" Const strTxtGuestsAnd = "Guest(s) and" Const strTxtMembers = "Member(s)" Const strTxtPreview = "Preview" Const strTxtThereIsNothingToPreview = "There is nothing to preview" Const strTxtEnterTextYouWouldLikeIn = "Enter the text that you would like in" Const strTxtEmailAddressAlreadyUsed = "Sorry, the email address entered has already been used to register another member." Const strTxtIP = "IP" Const strTxtIPLogged = "IP Logged" Const strTxtPages = "Pages" Const strTxtCharacterCount = "Character Count" Const strTxtAdmin = "Admin" Const strTxtType = "Group" Const strTxtActive = "Active" Const strTxtGuest = "Guest" Const strTxtAccountStatus = "Account Status" Const strTxtNotActive = "Not Active" Const strTxtEmailRequiredForActvation = "Required to be able to receive an email to activate your membership" Const strTxtToActivateYourMembershipFor = "To activate your membership for" Const strTxtForumClickOnTheLinkBelow = "click on the link below" Const strTxtForumAdmin = "Forum Admin" Const strTxtViewLastPost = "View Last Post" Const strTxtSelectAvatar = "Select Avatar" Const strTxtAvatar = "Avatar" Const strTxtSelectAvatarDetails = "This is the small icon shown next to your posts. Either select one from the list or type the path in to your own Avatar (must be " Const strTxtPixels = " pixels)." Const strTxtForumCodesInSignature = "can be used in your signature" Const strTxtHighPriorityPost = "Announcement" Const strTxtHighPriorityPostLocked = "Locked Announcement" Const strTxtHotTopicNewReplies = "Hot Topic [new posts]" Const strTxtHotTopic = "Hot Topic [no new posts]" Const strTxtOpenTopic = "Topic [no new posts]" Const strTxtOpenTopicNewReplies = "Topic [new post]" Const strTxtPinnedTopic = "Sticky Topic" Const strTxtOpenForum = "Open Forum [no new posts]" Const strTxtOpenForumNewReplies = "Open Forum [new posts]" Const strTxtReadOnly = "Read Only [no new replies]" Const strTxtReadOnlyNewReplies = "Read Only [new posts]" Const strTxtPasswordRequired = "Password Required" Const strTxtNoAccess = "No Access" Const strTxtFont = "Font" Const strTxtSize = "Size" Const strTxtForumCodes = "Forum Codes" Const strTxtPriority = "Sticky Topic" Const strTxtNormal = "Normal Topic" Const strTxtTopAllForums = "Announcement (all forums)" Const strTopThisForum = "Announcement (this forum)" Const strTxtMarkAllPostsAsRead = "Mark all posts as read" Const strTxtDeleteCookiesSetByThisForum = "Delete cookies set by this forum" 'forum_codes '--------------------------------------------------------------------------------- Const strTxtYouCanUseForumCodesToFormatText = "You can use the following Forum Codes to Format your text" Const strTxtTypedForumCode = "Typed Forum Code" Const strTxtConvetedCode = "Converted Code" Const strTxtTextFormating = "Text Formatting" Const strTxtImagesAndLinks = "Images and Links" Const strTxtFontTypes = "Font Types" Const strTxtFontSizes ="Font Sizes" Const strTxtFontColours ="Font Colours" Const strTxtEmoticons = "Emoticons" Const strTxtFontSize = "Font Size" Const strTxtMyLink = "My Link" Const strTxtMyEmail = "My Email" 'insufficient_permission.asp '--------------------------------------------------------------------------------- Const strTxtAccessDenied = "Access Denied" Const strTxtInsufficientPermison = "Sorry, only members with sufficient permission can access this page." 'activate.asp '--------------------------------------------------------------------------------- Dim strTxtYourForumMemIsNowActive strTxtYourForumMemIsNowActive = "Thank-you for registering.

Your " & strMainForumName & " membership is now active." Dim strTxtErrorWithActvation strTxtErrorWithActvation = "There is a problem activating your membership.

Please contact the " & strMainForumName & " Forum Administrator." 'register_mail_confirm.asp '--------------------------------------------------------------------------------- Const strTxtYouShouldReceiveAnEmail = "You should receive an email in the next 15 minutes.
Click on the link in this email to activate your Forum Membership." Const strTxtThankYouForRegistering = "Thank-you for registering to use" Const strTxtIfErrorActvatingMembership = "If you have a problem activating your membership please contact the" 'active_users.asp '--------------------------------------------------------------------------------- Const strTxtActiveForumUsers = "Active Forum Users" Const strTxtAddMToActiveUsersList = "Add me to Active Users list" Const strTxtLoggedIn = "Logged In" Const strTxtLastActive = "Last Active" Const strTxtBrowser = "Browser" Const strTxtOS = "OS" Const strTxtMinutes = "minutes" Const strTxtAnnoymous = "Anonymous" 'not_posted.asp '--------------------------------------------------------------------------------- Const strTxtMessageNotPosted = "Message Not Posted" Const strTxtDoublePostingIsNotPermitted = "Double posting is not permitted; your message has been posted already." Const strTxtSpammingIsNotPermitted = "Spamming is not permitted!" Const strTxtYouHaveExceededNumOfPostAllowed = "You have exceeded the number of posts permitted in the time span.

Please try again later." Const strTxtYourMessageNoValidSubjectHeading = "Your message did not contain a valid subject heading and/or message body." 'active_topics.asp '--------------------------------------------------------------------------------- Const strTxtActiveTopics = "Active Topics" Const strTxtLastVisitOn = "Last visit on" Const strTxtLastFifteenMinutes = "Last 15 minutes" Const strTxtLastThirtyMinutes = "Last 30 minutes" Const strTxtLastFortyFiveMinutes = "Last 45 minutes" Const strTxtLastHour = "Last hour" Const strTxtLastTwoHours = "Last 2 hours" Const strTxtYesterday = "Yesterday" Const strTxtShowActiveTopicsSince = "Show Active Topics since" Const strTxtNoActiveTopicsSince = "There are no Active Topics since" Const strTxtToDisplay = "to display" Const strTxtThereAreCurrently = "There are currently" 'pm_check.inc '--------------------------------------------------------------------------------- Const strTxtNewPMsClickToGoNowToPM = "new Private Message(s).\n\nClick OK to go to go to your Private Messenger." 'display_forum_topics.inc '--------------------------------------------------------------------------------- Const strTxtFewYears = "few years" Const strTxtWeek = "week" Const strTxtTwoWeeks = "two weeks" Const strTxtMonth = "month" Const strTxtTwoMonths = "two months" Const strTxtSixMonths = "6 months" Const strTxtYear = "year" 'Colours '--------------------------------------------------------------------------------- Const strTxtBlack = "Black" Const strTxtWhite = "White" Const strTxtBlue = "Blue" Const strTxtRed = "Red" Const strTxtGreen = "Green" Const strTxtYellow = "Yellow" Const strTxtOrange = "Orange" Const strTxtBrown = "Brown" Const strTxtMagenta = "Magenta" Const strTxtCyan = "Cyan" Const strTxtLimeGreen = "Lime Green" Const strTxtHasBeenSentTo = "has been sent to" Const strTxtCharactersInYourSignatureToLong = "characters in your signature, you must shorten it to below 200" Const strTxtSorryYourSearchFoundNoMembers = "Sorry, your search found no forum members that match your criteria" Const strTxtCahngeOfEmailReactivateAccount = "If you change your email address you will be sent an email to re-activate your account" Const strTxtAddToBuddyList = "Add to Buddy List" 'register_mail_confirm.asp '--------------------------------------------------------------------------------- Const strTxtYourEmailAddressHasBeenChanged = "Your email address has been changed,
you will have to re-activate your forum membership before you can use the forum again." Const strTxtYouShouldReceiveAReactivateEmail = "You should receive an email in the next 15 minutes.
Click on the link in this email to re-activate your Forum Membership." 'New from version 6.27 'Preview signature windows '--------------------------------------------------------------------------------- Const strTxtSignaturePreview = "Signature Preview" Const strTxtPostedMessage = "Posted Message" 'New from version 7 '--------------------------------------------------------------------------------- Const strTxtMemberlist = "Memberlist" Const strTxtForums = "Forum(s)" Const strTxtOurUserHavePosted = "Our users have posted" Const strTxtInTotalThereAre = "In total there are" Const strTxtOnLine = "online" Const strTxtWeHave = "We have" Const strTxtActivateAccount = "Activate Account" Const strTxtSorryYouDoNotHavePermissionToPostInTisForum = "Sorry, you do not have permission to post new topics in this forum" Const strTxtSorryYouDoNotHavePerimssionToReplyToPostsInThisForum = "Sorry, you do not have permission to reply to posts in this forum" Const strTxtSorryYouDoNotHavePerimssionToReplyIPBanned = "Sorry, you can not reply to posts, your IP address or range is not permitted.
Please contact the forum administrator if you feel this is in error." Const strTxtLoginSm = "login" Const strTxtYourProfileHasBeenUpdated = "Your profile has been updated." Const strTxtPosted = "Posted:" Const strTxtBackToTop = "Back to Top" Const strTxtNewPassword = "New Password" Const strTxtRetypeNewPassword = "Retype New Password" Const strTxtRegards = "Regards" Const strTxtClickTheLinkBelowToUnsubscribe = "To Un-subscribe from email notification for this Topic or Forum click on the link below " Const strTxtPostsPerDay = "posts per day" Const strTxtGroup = "Group" Const strTxtLastVisit = "Last Visit" Const strTxtPrivateMessage = "Private Message" Const strTxtSorryFunctionNotPermiitedIPBanned = "Sorry, this function is not available as you are using an IP address or range that is not permitted.
Please contact the forum administrator if you feel this is in error." Const strTxtEmailAddressBlocked = "Sorry, the email address or domain entered has been blocked by the forum administrator" Const strTxtTopicAdmin = "Topic Admin" Const strTxtMovePost = "Move Post" Const strTxtPrevTopic = "Prev Topic" Const strTxtTheMemberHasBeenDleted = "The Member has been Deleted." Const strTxtThisPageWasGeneratedIn = "This page was generated in" Const strTxtSeconds = "seconds." Const strTxtEditBy = "Edited by" Const strTxtWrote = "wrote" Const strTxtEnable = "Enable" Const strTxtToFormatPosts = "to format post" Const strTxtFlashFilesImages = "Flash Files/Images" Const strTxtSessionIDErrorCheckCookiesAreEnabled = "A security error has occurred with authentication.
Please ensure that all cookies are enabled on your web browser, and you are not using a saved or cached copy of the page." Const strTxtName = "Name" Const strTxtModerators = "Moderators" Const strTxtMore = "more..." Const strTxtNewRegSuspendedCheckBackLater = "Sorry, new registrations are currently suspended, please check back again later." Const strTxtMoved = "Moved: " Const strTxtNoNameError = "Name \t\t- Enter your name" Const strTxtHelp = "Help" 'PM system '--------------------------------------------------------------------------------- Const strTxtPrivateMessenger = "Private Messenger" Const strTxtUnreadMessage = "Unread message" Const strTxtReadMessage = "Read message" Const strTxtNew = "new" Const strTxtYouHave = "You have" Const strTxtNewMsgsInYourInbox = "new message(s) in your inbox!" Const strTxtNoneSelected = "None Selected" Const strTxtAddBuddy = "Add Buddy" 'active_topics.asp '--------------------------------------------------------------------------------- Const strTxtSelectMember = "Select Member" Const strTxtSelect = "Select" Const strTxtNoMatchesFound = "No matches found" 'active_topics.asp '--------------------------------------------------------------------------------- Const strTxtLastFourHours = "Last 4 hours" Const strTxtLastSixHours = "Last 6 hours" Const strTxtLastEightHours = "Last 8 hours" Const strTxtLastTwelveHours = "Last 12 hours" Const strTxtLastSixteenHours = "Last 16 hours" 'permissions '--------------------------------------------------------------------------------- Const strTxtYou = "You" Const strTxtCan = "can" Const strTxtCannot = "cannot" Const strTxtpostNewTopicsInThisForum = "post new topics in this forum" Const strTxtReplyToTopicsInThisForum = "reply to topics in this forum" Const strTxtEditYourPostsInThisForum = "edit your posts in this forum" Const strTxtDeleteYourPostsInThisForum = "delete your posts in this forum" Const strTxtCreatePollsInThisForum = "create polls in this forum" Const strTxtVoteInPOllsInThisForum = "vote in polls in this forum" 'register.asp '--------------------------------------------------------------------------------- Const strTxtRegistrationDetails = "Registration Details" Const strTxtProfileInformation = "Profile Information" Const strTxtForumPreferences = "Forum Preferences" Const strTxtICQNumber = "ICQ Number" Const strTxtAIMAddress = "AIM Address" Const strTxtMSNMessenger = "MSN Messenger" Const strTxtYahooMessenger = "Yahoo Messenger" Const strTxtOccupation = "Occupation" Const strTxtInterests = "Interests" Const strTxtDateOfBirth = "Date of Birth" Const strTxtNotifyMeOfReplies = "Notify me of replies to posts" Const strTxtSendsAnEmailWhenSomeoneRepliesToATopicYouHavePostedIn = "Sends an email when someone replies to a topic you have posted in. This can be changed whenever you post." Const strTxtNotifyMeOfPrivateMessages = "Notify me by email when I receive a Private Message" Const strTxtAlwaysAttachMySignature = "Always attach my signature to posts" Const strTxtEnableTheWindowsIEWYSIWYGPostEditor = "Enable the Windows IE 5 + WYSIWYG post editor" Const strTxtTimezone = "Time offset from forum time" Const strTxtPresentServerTimeIs = "Present server date and time is: " Const strTxtDateFormat = "Date Format" Const strTxtDayMonthYear = "Day/Month/Year" Const strTxtMonthDayYear = "Month/Day/Year" Const strTxtYearMonthDay = "Year/Month/Day" Const strTxtYearDayMonth = "Year/Day/Month" Const strTxtHours = "hours" Const strTxtDay = "Day" Const strTxtCMonth = "Month" Const strTxtCYear = "Year" Const strTxtRealName = "Real Name" Const strTxtMemberTitle = "Member Title" 'Polls '--------------------------------------------------------------------------------- Const strTxtCreateNewPoll = "Create New Poll" Const strTxtPollQuestion = "Poll Question" Const strTxtPollChoice = "Poll Choice" Const strTxtErrorPollQuestion = "Poll Question \t- Enter a Question for this Poll" Const strTxtErrorPollChoice = "Poll Choice \t- Enter a least two choices for this Poll" Const strTxtSorryYouDoNotHavePermissionToCreatePollsForum = "Sorry, you do not have permission to create polls in this forum" Const strTxtAllowMultipleVotes = "Allow Multiple Votes in this Poll" Const strTxtMakePollOnlyNoReplies = "Make Poll only (no replies allowed)" Const strTxtYourNoValidPoll = "Your Poll did not contain a valid Question or Choices." Const strTxtPoll = "Poll:" Const strTxtVote = "Vote" Const strTxtVotes = "Votes" Const strTxtCastMyVote = " Cast My Vote" Const strTxtPollStatistics = "Poll Statistics" Const strTxtThisTopicIsClosedNoNewVotesAccepted = "This topic is closed, no new votes accepted" Const strTxtYouHaveAlreadyVotedInThisPoll = "You have already voted in this poll" Const strTxtThankYouForCastingYourVote = "Thank-you for casting your vote." Const strsTxYouCanNotNotVoteInThisPoll = "You can not vote in this poll" Const strTxtYouDidNotSelectAChoiceForYourVote = "Sorry your vote was not cast.\n\nYou did not select a Poll Choice to vote for." Const strTxtThisIsAPollOnlyYouCanNotReply = "This is a Poll only, you can not post a reply." 'Email Notify '--------------------------------------------------------------------------------- Const strTxtWatchThisTopic = "Watch this topic for replies" Const strTxtUn = "Un-" Const strTxtWatchThisForum = "Watch this forum for new posts" Const strTxtYouAreNowBeNotifiedOfPostsInThisForum = "You will now be notified by email of all Posts in this Forum.\n\nTo un-watch this forum click on the \'Un-Watch this forum for new posts\' link at the bottom of the page." Const strTxtYouAreNowNOTBeNotifiedOfPostsInThisForum = "You will now not be notified by email of Posts in this Forum.\n\nTo re-watch this forum click on the \'Watch this forum for new posts\' link at the bottom of the page." Const strTxtYouWillNowBeNotifiedOfAllReplies = "You will now be notified by email of all Replies in this Topic.\n\nTo un-watch this topic click on the \'Un-Watch this topic for replies\' link at the bottom of the page." Const strTxtYouWillNowNOTBeNotifiedOfAllReplies = "You will now not be notified by email of Replies in this Topic.\n\nTo re-watch this topic click on the \'Watch this topic for replies\' link at the bottom of the page." 'email_messenger.asp '--------------------------------------------------------------------------------- Const strTxtEmailMessenger = "Email Messenger" Const strTxtRecipient = "Recipient" Const strTxtNoHTMLorForumCodeInEmailBody = "Please note that the email is sent in plain text only (no HTML or forum codes).

The return email address is set as your own." Const strTxtYourEmailHasBeenSentTo = "Your Email has been sent to" Const strTxtYouCanNotEmail = "You can not email" Const strTxtYouDontHaveAValidEmailAddr = "you do not have a valid email address in your profile." Const strTxtTheyHaveChoosenToHideThierEmailAddr = "they have chosen to hide their email address." Const strTxtTheyDontHaveAValidEmailAddr = "they do not have a valid email address in their profile." Const strTxtSendACopyOfThisEmailToMyself = "Send a copy of this email to myself" Const strTxtTheFollowingEmailHasBeenSentToYouBy = "The following email has been sent to you by" Const strTxtFromYourAccountOnThe = "from your account on the" Const strTxtIfThisMessageIsAbusive = "If this message is spam or you find offensive please contact the webmaster of the forum at the following address" Const strTxtIncludeThisEmailAndTheFollowing = "Include this email and the following" Const strTxtReplyToEmailSetTo = "Please note that the reply address to this email has been set to that of" Const strTxtMessageSent = "Message sent" 'Uploads '--------------------------------------------------------------------------------- Const strTxtImageUpload = "Image Upload" Const strTxtFileUpload = "File Upload" Const strTxtAvatarUpload = "Upload Avatar" Const strTxtUpload = "Upload" Const strTxtSelectTheImageYouWishToUpload = "Select the image you wish to upload" Const strTxtImagesMustBeOfTheType = "Images must be of the type" Const strTxtAndHaveMaximumFileSizeOf = "and have a maximum file size of" Const strTxtImageOfTheWrongFileType = "The image uploaded is of the wrong file type" Const strTxtImageFileSizeToLarge = "The image file size is to large at" Const strTxtMaximumFileSizeMustBe = "Maximum file size must be" Const strTxtSelectTheFileYouWishToUpload = "Select the file you wish to upload" Const strTxtFilesMustBeOfTheType = "Files must be of the type" Const strTxtFileOfTheWrongFileType = "The file uploaded is of the wrong file type" Const strTxtFileSizeToLarge = "The file size is to large at" Const strTxtSelectImageMessageError = "Image \t- Select an image to upload" Const strTxtSelectFileMessageError = "File \t- Select a file to upload" Const strTxtPleaseWaitWhileFileIsUploaded = "Please be patient while the file is being uploaded to the server." Const strTxtPleaseWaitWhileImageIsUploaded = "Please be patient while the image is being uploaded to the server." 'forum_closed.asp '--------------------------------------------------------------------------------- Const strTxtForumClosed = "Forums Closed" Const strTxtSorryTheForumsAreClosedForMaintenance = "Sorry, the forums are presently closed for maintenance.
Please check back again later." 'report_post.asp '--------------------------------------------------------------------------------- Const strTxtReportPost = "Report Post" Const strTxtSendReport = "Send Report" Const strTxtProblemWithPost = "Problem With Post" Const strTxtPleaseStateProblemWithPost = "Please state below the issue with the post, a copy of the post will be emailed to the forum moderators and/or forum administrators so they can deal with it appropriately." Const strTxtTheFollowingReportSubmittedBy = "The following report has been submitted by" Const strTxtWhoHasTheFollowingIssue = "who has the following issue with this post" Const strTxtToViewThePostClickTheLink = "To view the post then click on the link below" Const strTxtIssueWithPostOn = "Issue With Post on" Const strTxtYourReportEmailHasBeenSent = "Your email has been sent to the forum moderators and/or forum administrators so they can deal with it appropriately." %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Set the timeout of the forum Server.ScriptTimeout = 90 Session.Timeout = 20 'Set the date time format to your own if you are getting a CDATE error 'Session.LCID = 1033 Dim adoCon 'Database Connection Variable Object Dim strCon 'Holds the string to connect to the db Dim rsCommon 'Holds the configuartion recordset Dim strSQL 'Holds the SQL query for the database Dim lngLoggedInUserID 'Holds a logged in users ID number Dim strLoggedInUsername 'Holds a logged in users username Dim intGroupID 'Holds the group ID number the member is a group of Dim strWebsiteName 'Holds the website name Dim strMainForumName 'Holds the forum name Dim strForumPath 'Holds the virtual path to the forum Dim strForumEmailAddress 'Holds the forum e-mail address Dim blnTextLinks 'Set to true if you want text links instead of the powered by logo Dim blnIEEditor 'Set to true if the HTML editor for IE 5+ is turned on Dim blnEmail 'Boolean set to true if e-mail is on Dim strMailComponent 'Email coponent the forum useses Dim strIncomingMailServer 'Forums incomming mail server Dim strLoggedInUserCode 'Holds the user code of the user Dim blnLCode 'set to true Dim blnAdmin 'set to true if the user is a forum admininstrator (Group ID 1) Dim blnModerator 'Set to true if the user is a forum moderator Dim blnGuest 'set to true for the Guest account (Group ID 2) Dim blnActiveMember 'Set to false if the member is no longer allowed to post messages on the forum Dim blnLoggedInUserEmail 'Set to true if the user has entered there e-mail Dim blnLoggedInUserSignature 'set to true if the user has enetered a signature Dim intTopicPerPage 'Holds the number of topics to show on each page Dim strTitleImage 'Holds the path and name for the title image for the forum Dim blnEmoticons 'Set to true if emoticons are turned on Dim strDatabaseDateFunction 'Holds a different date function for Access or SQL server Dim strDatabaseType 'Holds the type of database used Dim blnGuestPost 'Set to true if guests can post Dim blnAvatar 'Set to true if the forum can use avatars Dim blnEmailActivation 'Set to true if the e-mail activation is turned on Dim blnSendPost 'Set to true if post is sent with e-mail notification Dim intNumHotViews 'Holds the number of how many views a topic has before it becomes a hot topic Dim intNumHotReplies 'Holds the number of replies before a topic becomes a hot topic Dim blnPrivateMessages 'Set to true if private messages are allowed Dim intNumPrivateMessages 'Holds the number of private messages allowed by each user Dim intThreadsPerPage 'Holds the number of threads shown per page Dim strDbPathAndName 'Holds the path and name of the database Dim intSpamTimeLimitSeconds 'Holds the number of secounds between posts Dim intSpamTimeLimitMinutes 'Holds the number of minutes the user can post five posts in Dim strDateFormat 'Holds the users date format Dim strTimeOffSet 'Holds the users time offset in + or - Dim intTimeOffSet 'Holds the users time offset Dim blnReplyNotify 'Set to true if the user wants to be notified of replies to posts Dim blnAttachSignature 'Set to true if the user always wants there signature attached Dim blnWYSIWYGEditor 'Set to true if the user wants to use the IE WYSIWYG post editor Dim intMaxPollChoices 'Holds the maximum allowed number of poll choices Dim blnEmailMessenger 'Set to true if the email system is on Dim blnActiveUsers 'Set to true if active users is enabled Dim blnForumClosed 'Set to true of the forum is cloded for maintence Dim blnShowEditUser 'Set to true if we are to show the username and time a post is edited Dim blnShowProcessTime 'Set to true if we are to show how long the page took to be processed on the server Dim dblStartTime 'Holds the start time for the page process Dim blnClosedForumPage 'Set to true if we are looking at the closed forum page Dim blnFlashFiles 'Set to true if Flash support is enabled Dim strWebsiteURL 'Holds the URL to the sites homepage Dim blnShowMod 'Set to true if mod groups are shown on the main forum page Dim blnAvatarUploadEnabled 'Set to true if avatars are enabled Dim blnRegistrationSuspeneded 'Set to true if new registrations are suspended 'These are used for forum permissions Dim blnRead Dim blnPost Dim blnReply Dim blnEdit Dim blnDelete Dim blnPriority Dim blnPollCreate Dim blnVote Dim blnAttachments Dim blnImageUpload 'Delete these later Dim intMemberStatus 'Holds the members status level intMemberStatus = 0 'Initialise variables Const strVersion = "7.01" lngLoggedInUserID = 0 strLoggedInUsername = strTxtGuest blnActiveMember = True blnLoggedInUserEmail = False blnLoggedInUserSignature = False intGroupID = 2 lngLoggedInUserID = 2 blnAdmin = False blnModerator = False blnGuest = True intTimeOffSet = 0 strTimeOffSet = "+" blnWYSIWYGEditor = True 'Set up the database table name prefix and stored procedure prefix '(This is useful if you are running multiple forums from one database) ' - make sure you also change this in the msSQL_server_setup.asp file if setting up an ms SQL server database) Const strDbTable = "tbl" Const strDbProc = "wwfSp" 'Database Type strDatabaseType = "Access" 'strDatabaseType = "SQLServer" 'Create database connection 'Create a connection odject Set adoCon = Server.CreateObject("ADODB.Connection") '--------------------- Set the path and name of the database -------------------------------------------------------------------------------- 'Virtual path to database strDbPathAndName = Server.MapPath("admin/database/wwForum.mdb") 'This is the path of the database from this files location on the server 'Physical path to database 'strDbPathAndName = "" 'Use this if you use the physical server path, eg:- C:\Inetpub\private\wwForum.mdb 'BRINKSTER USERS 'Brinkster users remove the ' single quote mark from infront of the line below and replace USERNAME with your Brinkster uersname 'strDbPathAndName = Server.MapPath("/USERNAME/db/wwForum.mdb") 'PLEASE NOTE: - For extra security it is highly recommended you change the name of the database, wwForum.mdb, to another name and then 'replace the wwForum.mdb found above with the name you changed the forum database to. '--------------------------------------------------------------------------------------------------------------------------------------------- '------------- If you are having problems with the script then try using a diffrent driver or DSN by editing the lines below -------------- 'Database connection info and driver (if this driver does not work then comment it out and use one of the alternative drivers) 'strCon = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & strDbPathAndName 'Alternative drivers faster than the generic one above 'strCon = "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=" & strDbPathAndName 'This one is if you convert the database to Access 97 strCon = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDbPathAndName 'This one is for Access 2000/2002 'If you wish to use DSN then comment out the driver above and uncomment the line below (DSN is slower than the above drivers) 'strCon = "DSN=DSN_NAME" 'Place the DSN where you see DSN_NAME '--------------------------------------------------------------------------------------------------------------------------------------------- 'Set the diffrent variables for diffrent database types If strDatabaseType = "SQLServer" Then %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** Dim strSQLServerName 'Holds the name of the SQL Server Dim strSQLDBUserName 'Holds the user name (for SQL Server Authentication) Dim strSQLDBPassword 'Holds the password (for SQL Server Authentication) Dim strSQLDBName 'Holds name of a database on the server '------------- The Driver Below is if you are using SQL Server (Do Not Use Unless you know and have an SQL Server) --------------------------- 'Enter the details of your SQL server below strSQLServerName = "" 'Holds the name of the SQL Server strSQLDBUserName = "" 'Holds the user name (for SQL Server Authentication) strSQLDBPassword = "" 'Holds the password (for SQL Server Authentication) strSQLDBName = "" 'Holds name of a database on the server 'Please note the forum has been optimised for the SQL OLE DB Driver using another driver 'or system DSN to connect to the SQL Server database will course errors in the forum and 'drastically reduce the performance of the forum! 'The SQLOLEDB driver offers the highest performance at this time for connecting to SQL Server databases from within ASP. 'MS SQL Server OLE Driver (If you change this string make sure you also change it in the msSQL_server_setup.asp file when creating the database) strCon = "Provider=SQLOLEDB;Server=" & strSQLServerName & ";User ID=" & strSQLDBUserName & ";Password=" & strSQLDBPassword & ";Database=" & strSQLDBName & ";" '--------------------------------------------------------------------------------------------------------------------------------------------- %> <% End If If strDatabaseType = "SQLServer" Then 'The GetDate() function is used in SQL Server strDatabaseDateFunction = "GetDate()" Else 'The now() function is used in Access strDatabaseDateFunction = "Now()" End If 'Set the connection string to the database adoCon.connectionstring = strCon 'Set an active connection to the Connection object adoCon.Open 'Read in the Forum configuration 'Intialise the ADO recordset object Set rsCommon = Server.CreateObject("ADODB.Recordset") 'Initialise the SQL variable with an SQL statement to get the configuration details from the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "SelectConfiguration" Else strSQL = "SELECT TOP 1 " & strDbTable & "Configuration.* From " & strDbTable & "Configuration;" End If 'Query the database rsCommon.Open strSQL, adoCon 'If there is config deatils in the recordset then read them in If NOT rsCommon.EOF Then 'read in the configuration details from the recordset strWebsiteName = rsCommon("website_name") strMainForumName = rsCommon("forum_name") strWebsiteURL = rsCommon("website_path") strForumPath = rsCommon("forum_path") strMailComponent = rsCommon("mail_component") strIncomingMailServer = rsCommon("mail_server") strForumEmailAddress = rsCommon("forum_email_address") blnLCode = CBool(rsCommon("L_Code")) blnEmail = CBool(rsCommon("email_notify")) blnTextLinks = rsCommon("Text_link") blnIEEditor = CBool(rsCommon("IE_editor")) intTopicPerPage = CInt(rsCommon("Topics_per_page")) strTitleImage = rsCommon("Title_image") blnEmoticons = CBool(rsCommon("Emoticons")) blnAvatar = CBool(rsCommon("Avatar")) blnEmailActivation = CBool(rsCommon("Email_activate")) intNumHotViews = CInt(rsCommon("Hot_views")) intNumHotReplies = CInt(rsCommon("Hot_replies")) blnSendPost = CBool(rsCommon("Email_post")) blnPrivateMessages = CBool(rsCommon("Private_msg")) intNumPrivateMessages = CInt(rsCommon("No_of_priavte_msg")) intThreadsPerPage = CInt(rsCommon("Threads_per_page")) intSpamTimeLimitSeconds = CInt(rsCommon("Spam_seconds")) intSpamTimeLimitMinutes = CInt(rsCommon("Spam_minutes")) intMaxPollChoices = CInt(rsCommon("Vote_choices")) blnEmailMessenger = CBool(rsCommon("Email_sys")) blnActiveUsers = CBool(rsCommon("Active_users")) If blnClosedForumPage = False Then blnForumClosed = CBool(rsCommon("Forums_closed")) blnShowEditUser = CBool(rsCommon("Show_edit")) blnShowProcessTime = CBool(rsCommon("Process_time")) blnFlashFiles = CBool(rsCommon("Flash")) blnShowMod = CBool(rsCommon("Show_mod")) blnAvatarUploadEnabled = CBool(rsCommon("Upload_avatar")) blnRegistrationSuspeneded = CBool(rsCommon("Reg_closed")) End If 'Close the recordset rsCommon.Close 'If the forums are closed redirect to the forums closed page If blnForumClosed Then 'Reset server objects Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to the forum closed page Response.Redirect("forum_closed.asp") End If 'Get the process start time If blnShowProcessTime Then dblStartTime = Timer() 'Set a cookie with the last date/time the user used the forum to calculate if there any new posts 'If the date/time the user was last here is 20 minutes since the last visit then set the session variable to the users last date they were here If Session("dtmLastVisit") = "" AND Request.Cookies("FLVST")("LTVST") <> "" Then Session("dtmLastVisit") = CDate(Request.Cookies("FLVST")("LTVST")) Response.Cookies("FLVST")("LTVST") = CDbl(Now()) Response.Cookies("FLVST").Expires = DateAdd("yyyy", 1, Now()) 'If the last entry date is not alreay set set it to now ElseIf Session("dtmLastVisit") = "" Then Session("dtmLastVisit") = Now() End If 'If the cookie is older than 5 mintues set a new one If isNumeric(Request.Cookies("FLVST")("LTVST")) Then If CDate(Request.Cookies("FLVST")("LTVST")) < DateAdd("n", -5, Now()) Then Response.Cookies("FLVST")("LTVST") = CDbl(Now()) Response.Cookies("FLVST").Expires = DateAdd("yyyy", 1, Now()) End If 'If there is no date in the cookie or it is empty then set the date to now() Else Response.Cookies("FLVST")("LTVST") = CDbl(Now()) Response.Cookies("FLVST").Expires = DateAdd("yyyy", 1, Now()) End If 'If someone has placed the default.asp in the path to the forum then remove it as it's not needed strForumPath = Replace(strForumPath, "default.asp", "") 'Read in users ID number from the cookie strLoggedInUserCode = Trim(Mid(Request.Cookies("Forum")("UID"), 1, 44)) 'If a cookie exsists on the users system then read in there username from the database If strLoggedInUserCode <> "" Then 'Make the usercode SQL safe strLoggedInUserCode = formatSQLInput(strLoggedInUserCode) 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ChkUserID @strUserID = '" & strLoggedInUserCode & "'" Else strSQL = "SELECT " & strDbTable & "Author.Username, " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Group_ID, " & strDbTable & "Author.Active, " & strDbTable & "Author.Signature, " & strDbTable & "Author.Author_email, " & strDbTable & "Author.Date_format, " & strDbTable & "Author.Time_offset, " & strDbTable & "Author.Time_offset_hours, " & strDbTable & "Author.Reply_notify, " & strDbTable & "Author.Attach_signature, " & strDbTable & "Author.Rich_editor, " & strDbTable & "Author.Last_visit " strSQL = strSQL & "FROM " & strDbTable & "Author " strSQL = strSQL & "WHERE " & strDbTable & "Author.User_code = '" & strLoggedInUserCode & "';" End If 'Query the database rsCommon.Open strSQL, adoCon 'If the database has returned a record then run next bit If NOT rsCommon.EOF Then 'Read in the users details from the recordset strLoggedInUsername = rsCommon("Username") intGroupID = rsCommon("Group_ID") lngLoggedInUserID = CLng(rsCommon("Author_ID")) blnActiveMember = CBool(rsCommon("Active")) strDateFormat = rsCommon("Date_format") strTimeOffSet = rsCommon("Time_offset") intTimeOffSet = CInt(rsCommon("Time_offset_hours")) blnReplyNotify = CBool(rsCommon("Reply_notify")) blnAttachSignature = CBool(rsCommon("Attach_signature")) blnWYSIWYGEditor = CBool(rsCommon("Rich_editor")) If rsCommon("Author_Email") <> "" Then blnLoggedInUserEmail = True If rsCommon("Signature") <> "" Then blnLoggedInUserSignature = True 'Read in the Last Visit Date for the user from the db if we haven't already If Session("ViRead") = "" Then If isDate(rsCommon("Last_visit")) Then Session("dtmLastVisit") = CDate(rsCommon("Last_visit")) Session("ViRead") = True End If 'Check that there is a last visit date in the db or we will get an error If isDate(rsCommon("Last_visit")) Then 'If the Last Visit date in the db is older than 5 minutes for the user then update it If CDate(rsCommon("Last_visit")) < DateAdd("n", -5, Now()) Then 'Initilse sql statement If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "UpdateLasVisit @lngUserID = " & lngLoggedInUserID Else strSQL = "UPDATE " & strDbTable & "Author SET " & strDbTable & "Author.Last_visit = Now() WHERE " & strDbTable & "Author.Author_ID=" & lngLoggedInUserID & ";" End If 'Write to database adoCon.Execute(strSQL) End If 'Else there is no date already in db for the last time this visitor came to the site so update db Else 'Initilse sql statement If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "UpdateLasVisit @lngUserID = " & lngLoggedInUserID Else strSQL = "UPDATE " & strDbTable & "Author SET " & strDbTable & "Author.Last_visit=Now() WHERE " & strDbTable & "Author.Author_ID=" & lngLoggedInUserID & ";" End If 'Write to database adoCon.Execute(strSQL) End If 'If the members account is not active then set there group to 2 (Guest Group) If blnActiveMember = False Then intGroupID = 2 'Set the Guest boolean to false blnGuest = False End If 'Clean up rsCommon.Close End If 'Make sure the admin account remains active and full access rights and in the admin group If lngLoggedInUserID = 1 Then intGroupID = 1 blnActiveMember = True End If 'If in the admin group set the admin boolean to true If intGroupID = 1 Then blnAdmin = True 'If active users is on update the table If blnActiveUsers Then %><% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide ASP Discussion Forum '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Dimension variables Dim strIPAddress 'Holds the uesrs IP address to keep track of em with Dim dtmLoggedIn 'Holds the date/time the user logged in Dim dtmLastActive 'Holds the date/time the user was last active Dim strOS 'Holds the users OS Dim strBrowserUserType 'Holds the users browser type 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 blnHideActiveUser 'Holds if the user wants to be shown in the active users list Dim lngActiveUsersID 'Hols the active users ID number 'Get the users IP address strIPAddress = Request.ServerVariables("REMOTE_ADDR") 'Get if the user wants to be shown in the active users list If Request.Cookies("Forum")("Hide") = "True" Then blnHideActiveUser = 1 Else blnHideActiveUser = 0 End If 'Calculate the active users ID number lngActiveUsersID = lngLoggedInUserID 'Initialise the SQL variable with an SQL statement to get the active users details If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ActiveUsersWhereIPis @strIPAddress = '" & strIPAddress & "'" Else strSQL = "SELECT " & strDbTable & "ActiveUser.* From " & strDbTable & "ActiveUser WHERE IP='" & strIPAddress & "';" End If 'Query the database rsCommon.Open strSQL, adoCon 'If there are no records for this user then add them to the datatbase If rsCommon.EOF Then 'Get the uesrs web browser strBrowserUserType = BrowserType() 'Get the OS type strOS = OSType() 'If the user is not in the active users list then write them to it 'Initilse sql statement If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "AddNewActiveUser @strIPAddress = '" & strIPAddress & "', @lngActiveUsersID = '" & lngActiveUsersID & "', @strOS = '" & strOS & "', @strBrowserUserType = '" & strBrowserUserType & "', @blnHideActiveUser = '" & blnHideActiveUser & "'" Else strSQL = "INSERT INTO " & strDbTable & "ActiveUser (IP, Author_ID, OS, Browser, Hide) VALUES ('" & strIPAddress & "','" & lngActiveUsersID & "','" & strOS & "','" & strBrowserUserType & "','" & blnHideActiveUser & "');" End If 'Write to database adoCon.Execute(strSQL) 'Else if there's records returned then update them Else 'The user is already in the db so just update the recordset 'Initilse sql statement If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "UpdateActiveUser @lngActiveUsersID = '" & lngActiveUsersID & "', @blnHideActiveUser = '" & blnHideActiveUser & "', @strIPAddress = '" & strIPAddress & "'" Else strSQL = "UPDATE " & strDbTable & "ActiveUser SET " & strDbTable & "ActiveUser.Author_ID=" & lngActiveUsersID & ", " & strDbTable & "ActiveUser.Active=Now(), " & strDbTable & "ActiveUser.Hide=" & blnHideActiveUser & " WHERE IP='" & strIPAddress & "';" End If 'Write to database adoCon.Execute(strSQL) 'Clean up old users 'Initilse sql statement If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "DeleteActiveUser" Else strSQL = "DELETE FROM " & strDbTable & "ActiveUser WHERE " & strDbTable & "ActiveUser.Active < Now() - 0.0070;" End If 'Detlete from database adoCon.Execute(strSQL) 'Delete older second entries if the user has returned in under 10 minutes with a new IP If lngActiveUsersID <> 2 Then If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "DeleteActiveUserDoubleEntry @lngActiveUsersID = " & lngActiveUsersID & ", @strIPAddress = '" & strIPAddress & "'" Else strSQL = "DELETE FROM " & strDbTable & "ActiveUser WHERE " & strDbTable & "ActiveUser.Author_ID=" & lngActiveUsersID & " AND " & strDbTable & "ActiveUser.IP <> '" & strIPAddress & "';" End If 'Detlete from database adoCon.Execute(strSQL) End If 'Requery the database to allow access to catch up rsCommon.Requery End If 'Close the recordset rsCommon.Close %><% End If %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide ASP Discussion Forum '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** '****************************************** '*** Create Usercode ***** '****************************************** Private Function userCode(ByVal strUsername) 'Randomise the system timer Randomize Timer 'Calculate a code for the user strUserCode = strUsername & hexValue(15) 'Make the usercode SQL safe strUserCode = formatSQLInput(strUserCode) 'Replace double quote with single in this intance strUserCode = Replace(strUserCode, "''", "'", 1, -1, 1) 'Return the function userCode = strUserCode End Function '****************************************** '*** Random Hex Generator **** '****************************************** Private Function hexValue(ByVal intHexLength) Dim intLoopCounter Dim strHexValue 'Randomise the system timer Randomize Timer() 'Generate a hex value For intLoopCounter = 1 to intHexLength 'Genreate a radom decimal value form 0 to 15 intHexLength = CInt(Rnd * 1000) Mod 16 'Turn the number into a hex value Select Case intHexLength Case 1 strHexValue = "1" Case 2 strHexValue = "2" Case 3 strHexValue = "3" Case 4 strHexValue = "4" Case 5 strHexValue = "5" Case 6 strHexValue = "6" Case 7 strHexValue = "7" Case 8 strHexValue = "8" Case 9 strHexValue = "9" Case 10 strHexValue = "A" Case 11 strHexValue = "B" Case 12 strHexValue = "C" Case 13 strHexValue = "D" Case 14 strHexValue = "E" Case 15 strHexValue = "F" Case Else strHexValue = "Z" End Select 'Place the hex value into the return string hexValue = hexValue & strHexValue Next End Function '****************************************** '*** See if Browser is Windows IE ***** '****************************************** Private Function IEWin() Dim strUserAgent 'Holds info on the users browser 'Get the users HTTP user agent (web browser) strUserAgent = Request.ServerVariables("HTTP_USER_AGENT") 'See if MSIE is found in the user agent string then the broser is namd not a MAC or Opera betending to be IE If InStr(1, strUserAgent, "MSIE", 1) AND InStr(1, strUserAgent, "MAC", 1) = 0 AND InStr(1, strUserAgent, "Opera", 1) = 0 Then 'Now we know this is IE we need to see if the version number is above 5 '(This must be done after finding if the browser is IE or the MID function will throw up an error) If Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "MSIE", 1)+5), 1)) => 5 Then IEWin = True 'If the IE version is below 5 then return the function as false Else IEWin = False End If 'Else this is another browser other than IE so return false Else IEWin = False End If End Function '****************************************** '*** Get Web Browser Details ***** '****************************************** Private Function BrowserType() Dim strUserAgent 'Holds info on the users browser and os Dim strBrowserUserType 'Holds the users browser type 'Get the users HTTP user agent (web browser) strUserAgent = Request.ServerVariables("HTTP_USER_AGENT") 'Get the uesrs web browser 'Opera If InStr(1, strUserAgent, "Opera 3", 1) Then strBrowserUserType = "Opera 3" ElseIf InStr(1, strUserAgent, "Opera 4", 1) Then strBrowserUserType = "Opera 4" ElseIf InStr(1, strUserAgent, "Opera 5", 1) Then strBrowserUserType = "Opera 5" ElseIf InStr(1, strUserAgent, "Opera 6", 1) Then strBrowserUserType = "Opera 6" ElseIf InStr(1, strUserAgent, "Opera", 1) Then strBrowserUserType = "Opera" 'Internet Explorer ElseIf inStr(1, strUserAgent, "MSIE 6", 1) Then strBrowserUserType = "Microsoft IE 6" ElseIf inStr(1, strUserAgent, "MSIE 5", 1) Then strBrowserUserType = "Microsoft IE 5" ElseIf inStr(1, strUserAgent, "MSIE 4", 1) Then strBrowserUserType = "Microsoft IE 4" ElseIf inStr(1, strUserAgent, "MSIE 3", 1) Then strBrowserUserType = "Microsoft IE 3" 'Netscape and Mozilla ElseIf inStr(1, strUserAgent, "Gecko/20030", 1) OR inStr(1, strUserAgent, "Netscape/7", 1) Then strBrowserUserType = "Netscape 7" ElseIf inStr(1, strUserAgent, "Mozilla/5", 1) OR inStr(1, strUserAgent, "Netscape6", 1) Then strBrowserUserType = "Netscape 6" ElseIf inStr(1, strUserAgent, "Mozilla/4", 1) Then strBrowserUserType = "Netscape 4" ElseIf inStr(1, strUserAgent, "Mozilla/3", 1) Then strBrowserUserType = "Netscape 3" 'Else unknown or robot Else strBrowserUserType = "Unknown" End If 'Return function BrowserType = strBrowserUserType End Function '****************************************** '*** Get OS Type ***** '****************************************** Private Function OSType () Dim strUserAgent 'Holds info on the users browser and os Dim strOS 'Holds the users OS 'Get the users HTTP user agent (web browser) strUserAgent = Request.ServerVariables("HTTP_USER_AGENT") 'Get users OS If inStr(1, strUserAgent, "NT 5.2", 1) Or inStr(1, strUserAgent, "Windows 2003", 1) Then strOS = "Windows 2003" ElseIf inStr(1, strUserAgent, "NT 5.1", 1) Or inStr(1, strUserAgent, "Windows XP", 1) Then strOS = "Windows XP" ElseIf inStr(1, strUserAgent, "NT 5", 1) Or inStr(1, strUserAgent, "Windows 2000", 1) Then strOS = "Windows 2000" ElseIf inStr(1, strUserAgent, "NT", 1) Or inStr(1, strUserAgent, "WinNT", 1) Then strOS = "Windows NT 4" ElseIf inStr(1, strUserAgent, "95", 1) Or inStr(1, strUserAgent, "Win95", 1) Then strOS = "Windows 95" ElseIf inStr(1, strUserAgent, "Win 9x 4.90", 1) Then strOS = "Windows ME" ElseIf inStr(1, strUserAgent, "98", 1) Or inStr(1, strUserAgent, "Win98", 1) Then strOS = "Windows 98" ElseIf Instr(1, strUserAgent, "Windows 3.1", 1) or Instr(1, strUserAgent, "Win16", 1) Then strOS = "Windows 3.x" ElseIf inStr(1, strUserAgent, "Macintosh", 1) OR inStr(1, strUserAgent, "Mac", 1) OR inStr(1, strUserAgent, "Macintosh;", 1) Then strOS = "Macintosh" ElseIf inStr(1, strUserAgent, "Linux", 1) Then strOS = "Linux" ElseIf inStr(1, strUserAgent, "Unix", 1) OR inStr(1, strUserAgent, "sunos", 1) OR inStr(1, strUserAgent, "X11", 1) Then strOS = "Unix" ElseIf inStr(1, strUserAgent, "WebTV", 1) OR inStr(1, strUserAgent, "AOL_TV", 1) Then strOS = "Web TV" Else strOS = "Unknown" End If 'Return function OSType = strOS End Function '****************************************** '*** DB Topic/Post Count Update ***** '****************************************** Private Function updateTopicPostCount(ByVal intForumID) Dim rsCount 'Database recordset holding the number of topics and posts Dim lngNumberOfTopics 'Holds the number of topics Dim lngNumberOfPosts 'Holds the number of posts 'Intilaise variables lngNumberOfTopics = 0 lngNumberOfPosts = 0 'Intialise the ADO recordset object Set rsCount = Server.CreateObject("ADODB.Recordset") 'Get the number of Topics 'Initalise the strSQL variable with an SQL statement to query the database to count the number of topics in the forums If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumTopicCount @intForumID = " & intForumID Else strSQL = "SELECT Count(" & strDbTable & "Topic.Forum_ID) AS Topic_Count " strSQL = strSQL & "From " & strDbTable & "Topic " strSQL = strSQL & "WHERE " & strDbTable & "Topic.Forum_ID = " & intForumID & " " End If 'Query the database rsCount.Open strSQL, adoCon 'Read in the number of Topics If NOT rsCount.EOF Then lngNumberOfTopics = CLng(rsCount("Topic_Count")) 'Close the rs rsCount.Close 'Get the number of Posts 'Initalise the strSQL variable with an SQL statement to query the database to count the number of threads in the forums If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumThreadCount @intForumID = " & intForumID Else strSQL = "SELECT Count(" & strDbTable & "Thread.Thread_ID) AS Thread_Count " strSQL = strSQL & "FROM " & strDbTable & "Topic INNER JOIN " & strDbTable & "Thread ON " & strDbTable & "Topic.Topic_ID = " & strDbTable & "Thread.Topic_ID " strSQL = strSQL & "GROUP BY " & strDbTable & "Topic.Forum_ID " strSQL = strSQL & "HAVING (((" & strDbTable & "Topic.Forum_ID)=" & intForumID & "));" End If 'Query the database rsCount.Open strSQL, adoCon 'Get the thread count If NOT rsCount.EOF Then lngNumberOfPosts = CLng(rsCount("Thread_Count")) 'Reset server variables rsCount.Close Set rsCount = Nothing 'Initalise the SQL string with an SQL update command to update the number of topics and posts in the forum strSQL = "UPDATE " & strDbTable & "Forum SET " strSQL = strSQL & "" & strDbTable & "Forum.No_of_topics = " & lngNumberOfTopics & ", " & strDbTable & "Forum.No_of_posts = " & lngNumberOfPosts strSQL = strSQL & " WHERE " & strDbTable & "Forum.Forum_ID= " & intForumID & ";" 'Write the updated number of posts to the database adoCon.Execute(strSQL) End Function '****************************************** '*** Forum Permisisons ***** '****************************************** Public Function forumPermisisons(ByVal intForumID, ByVal intGroupID, ByVal intRead, ByVal intPost, ByVal intReply, ByVal intEdit, ByVal intDelete, ByVal intPriority, ByVal intPollCreate, ByVal intVote, ByVal intAttachments, ByVal intImageUpload) 'Declare variables Dim rsPermissions 'Holds the permissions recordset 'Initilise variables blnRead = False blnPost = False blnReply = False blnEdit = False blnDelete = False blnPriority = False blnPollCreate = False blnVote = False blnAttachments = False blnImageUpload = False blnModerator = False 'Intialise the ADO recordset object Set rsPermissions = Server.CreateObject("ADODB.Recordset") 'Get the users group permissions from the db if there are any 'Initalise the strSQL variable with an SQL statement to query the database to count the number of topics in the forums If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumPermissions @intForumID = " & intForumID & ", @intGroupID = " & intGroupID & ", @intAuthorID = " & lngLoggedInUserID Else strSQL = "SELECT " & strDbTable & "Permissions.* " strSQL = strSQL & "FROM " & strDbTable & "Permissions " strSQL = strSQL & "WHERE (" & strDbTable & "Permissions.Group_ID = " & intGroupID & " OR " & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & ") AND " & strDbTable & "Permissions.Forum_ID = " & intForumID & " " strSQL = strSQL & "ORDER BY " & strDbTable & "Permissions.Author_ID DESC;" End If 'Query the database rsPermissions.Open strSQL, adoCon 'Read in the permissions for the group the member is part of if there are any If NOT rsPermissions.EOF Then blnRead = CBool(rsPermissions("Read")) blnPost = CBool(rsPermissions("Post")) blnReply = CBool(rsPermissions("Reply_posts")) blnEdit = CBool(rsPermissions("Edit_posts")) blnDelete = CBool(rsPermissions("Delete_posts")) blnPriority = CBool(rsPermissions("Priority_posts")) blnPollCreate = CBool(rsPermissions("Poll_create")) blnVote = CBool(rsPermissions("Vote")) blnAttachments = CBool(rsPermissions("Attachments")) blnImageUpload = CBool(rsPermissions("Image_upload")) blnModerator = CBool(rsPermissions("Moderate")) 'Else there are no forum permissions for this group so use the generic forum permissions Else 'If ALL(1) OR (REG(2) AND NOT GID2(Guest Group)) OR (Admin(5) AND GID1(Admin Group)) Then set to true If intRead = 1 OR (intRead = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnRead = True If intPost = 1 OR (intPost = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnPost = True If intReply = 1 OR (intReply = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnReply = True If intEdit = 1 OR (intEdit = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnEdit = True If intDelete = 1 OR (intDelete = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnDelete = True If intPriority = 1 OR (intPriority = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnPriority = True If (intPollCreate = 1 OR (intPollCreate = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intPollCreate <> 0 Then blnPollCreate = True If (intVote = 1 OR (intVote = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intVote <> 0 Then blnVote = True If (intAttachments = 1 OR (intAttachments = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intAttachments <> 0 Then blnAttachments = True If (intImageUpload = 1 OR (intImageUpload = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intImageUpload <> 0 Then blnImageUpload = True End If 'Clean up rsPermissions.Close Set rsPermissions = Nothing End Function '****************************************** '*** Is Moderator ***** '****************************************** 'Although the above function can work out if the user is a moderator sometimes we only need to know if the user is a moderator or not Private Function isModerator(ByVal intForumID, ByVal intGroupID) 'Declare variables Dim rsPermissions 'Holds the permissions recordset Dim blnModerator 'Set to true if the user is a moderator 'Initilise vairiables blnModerator = False 'Intialise the ADO recordset object Set rsPermissions = Server.CreateObject("ADODB.Recordset") 'Get the users group permissions from the db if there are any 'Initalise the strSQL variable with an SQL statement to query the database to count the number of topics in the forums If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumPermissions @intForumID = " & intForumID & ", @intGroupID = " & intGroupID & ", @intAuthorID = " & lngLoggedInUserID Else strSQL = "SELECT " & strDbTable & "Permissions.* " strSQL = strSQL & "FROM " & strDbTable & "Permissions " strSQL = strSQL & "WHERE (" & strDbTable & "Permissions.Group_ID = " & intGroupID & " OR " & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & ") AND " & strDbTable & "Permissions.Forum_ID = " & intForumID & " " strSQL = strSQL & "ORDER BY " & strDbTable & "Permissions.Author_ID DESC;" End If 'Query the database rsPermissions.Open strSQL, adoCon 'If there is a result returned by the db set it to the blnModerator variable If NOT rsPermissions.EOF Then blnModerator = CBool(rsPermissions("Moderate")) 'Clean up rsPermissions.Close Set rsPermissions = Nothing 'Return the function isModerator = blnModerator End Function '****************************************** '*** Disallowed Member Names ***** '****************************************** Private Function disallowedMemberNames(ByVal strUserName) strUsername = Replace(strUsername, "salt", "", 1, -1, 1) strUsername = Replace(strUsername, "password", "", 1, -1, 1) strUsername = Replace(strUsername, "author", "", 1, -1, 1) strUsername = Replace(strUsername, "code", "", 1, -1, 1) strUsername = Replace(strUsername, "username", "", 1, -1, 1) strUsername = Replace(strUsername, "N0act", "", 1, -1, 1) 'Return Function disallowedMemberNames = strUsername End Function '****************************************** '**** Banned IP's ***** '****************************************** Private Function bannedIP() 'Declare variables Dim rsIPAddr Dim strCheckIPAddress Dim strUserIPAddress Dim blnIPMatched 'Intilise variable blnIPMatched = False 'Get the users IP strUserIPAddress = Request.ServerVariables("REMOTE_ADDR") 'Intialise the ADO recordset object Set rsIPAddr = Server.CreateObject("ADODB.Recordset") 'Get any banned IP address from the database 'Initalise the strSQL variable with an SQL statement to query the database to count the number of topics in the forums If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "BannedIPs" Else strSQL = "SELECT " & strDbTable & "BanList.IP FROM " & strDbTable & "BanList WHERE " & strDbTable & "BanList.IP Is Not Null;" End If 'Query the database rsIPAddr.Open strSQL, adoCon 'Loop through the IP address and check 'em out Do while NOT rsIPAddr.EOF 'Get the IP address to check from the recordset strCheckIPAddress = rsIPAddr("IP") 'See if we need to check the IP range or just one IP address 'If the last character is a * then this is a wildcard range to be checked If Right(strCheckIPAddress, 1) = "*" Then 'Remove the wildcard charcter form the IP strCheckIPAddress = Replace(strCheckIPAddress, "*", "", 1, -1, 1) 'Trim the users IP to the same length as the IP range to check strUserIPAddress = Mid(strUserIPAddress, 1, Len(strCheckIPAddress)) 'See if whats left of the IP matches If strCheckIPAddress = strUserIPAddress Then blnIPMatched = True 'Else check the IP address metches Else 'Else check to see if the IP address match If strCheckIPAddress = strUserIPAddress Then blnIPMatched = True End If 'Move to the next record rsIPAddr.MoveNext Loop 'Clean up rsIPAddr.Close Set rsIPAddr = Nothing 'Return the function bannedIP = blnIPMatched End Function '****************************************** '*** Check the session ID *** '****************************************** Private Function checkSessionID(lngAspSessionID) 'Check to see if the session ID's match if they don't send the user away If lngAspSessionID <> Session.SessionID Then 'clean up before redirecting Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?FID=" & intForumID & "&M=sID") End If End Function %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** '********************************************** '*** Check HTML input for malicious code ***** '********************************************** 'Check images function Private Function checkHTML(ByVal strMessageInput) Dim strTempHTMLMessage 'Temporary message store Dim lngMessagePosition 'Holds the message position Dim intHTMLTagLength 'Holds the length of the HTML tags Dim strHTMLMessage 'Holds the HTML message Dim strTempMessageInput 'Temp store for the message input 'Place the message input into a temp store strTempMessageInput = strMessageInput 'Loop through each character in the post message For lngMessagePosition = 1 to CLng((Len(strMessageInput))) 'If this is the end of the message then save some process time and jump out the loop If Mid(strMessageInput, lngMessagePosition, 1) = "" Then Exit For 'If an HTML tag is found then move to the end of it so that no words in the HTML are highlighted If Mid(strMessageInput, lngMessagePosition, 1) = "<" Then 'Get the length of the HTML tag intHTMLTagLength = (InStr(lngMessagePosition, strMessageInput, ">", 1) - lngMessagePosition) 'Place the HTML tag back into the temporary message store strHTMLMessage = Mid(strMessageInput, lngMessagePosition, intHTMLTagLength + 1) 'Place the HTML tag into a temporay variable store to be stripped of malcious code strTempHTMLMessage = strHTMLMessage 'If this is an hyperlink tag then check it for malicious code If InStr(1, strTempHTMLMessage, "href", 1) <> 0 Then 'Turn < and > into forum codes so they aren't stripped when checking links strTempHTMLMessage = Replace(strTempHTMLMessage, "<", "**/**", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, ">", "**\**", 1, -1, 1) 'Call the format link function to strip malicious codes strTempHTMLMessage = formatLink(strTempHTMLMessage) 'Turn **/** and **\** back from forum codes strTempHTMLMessage = Replace(strTempHTMLMessage, "**/**", "<", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "**\**", ">", 1, -1, 1) 'Format link tag strTempHTMLMessage = Replace(strTempHTMLMessage, ">", " target=""_blank"">", 1, -1, 1) End If 'If this is an Image tag then check it for malicious code If InStr(1, strTempHTMLMessage, "img", 1) <> 0 Then 'Turn < and > into forum codes so they aren't stripped when checking links strTempHTMLMessage = Replace(strTempHTMLMessage, "<", "**/**", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, ">", "**\**", 1, -1, 1) 'Check image for malicious code strTempHTMLMessage = checkImages(strTempHTMLMessage) 'Turn **/** and **\** back from forum codes strTempHTMLMessage = Replace(strTempHTMLMessage, "**/**", "<", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "**\**", ">", 1, -1, 1) 'Format image tag strTempHTMLMessage = Replace(strTempHTMLMessage, ">", " border=""0"">", 1, -1, 1) End If 'If this is not an image or a link then cut all unwanted HTML out of the HTML tag If InStr(1, strTempHTMLMessage, "href", 1) = 0 AND InStr(1, strTempHTMLMessage, "img", 1) = 0 Then strTempHTMLMessage = Replace(strTempHTMLMessage, "html", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "body", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "head", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "meta", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "button", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "input", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "type", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "select", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "radio", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "file", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "hidden", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "checkbox", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "password", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "blink", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "fieldset", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "javascript", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "vbscript", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "script", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "object", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "applet", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "embed", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "event", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "server", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "function", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "document", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "cookie", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onclick", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "ondblclick", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onkey", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onmouse", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onchange", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "accesskey", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "tabindex", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onfocus", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onblur", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onsubmit", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "onreset", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "form", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "iframe", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "textarea", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "action", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "enctype", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "layer", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "multicol", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "frameset", "", 1, -1, 1) strTempHTMLMessage = Replace(strTempHTMLMessage, "marquee", "", 1, -1, 1) 'strTempHTMLMessage = Replace(strTempHTMLMessage, "table", "", 1, -1, 1) 'strTempHTMLMessage = Replace(strTempHTMLMessage, "tr", "", 1, -1, 1) 'strTempHTMLMessage = Replace(strTempHTMLMessage, "td", "", 1, -1, 1) End If 'Strip out malicious code from the HTML strTempHTMLMessage = formatInput(strTempHTMLMessage) 'Place the new fromatted HTML tag back into the message post strTempMessageInput = Replace(strTempMessageInput, strHTMLMessage, strTempHTMLMessage, 1, -1, 1) End If Next 'Return the function checkHTML = strTempMessageInput End Function '****************************************** '*** Check Images for malicious code ***** '****************************************** 'Check images function Private Function checkImages(ByVal strInputEntry) Dim strImageFileExtension 'Holds the file extension of the image 'If there is no . in the link then there is no extenison and so can't be an image If inStr(1, strInputEntry, ".", 1) = 0 Then strInputEntry = "" 'Else remove malicious code and check the extension is an image extension Else 'Get the file extension strImageFileExtension = LCase(Mid(strInputEntry, InStrRev(strInputEntry, "."), 4)) 'Check the file extension if it's not a web graphic then remove the extension If NOT (strImageFileExtension = ".gif" OR strImageFileExtension = ".jpg" OR strImageFileExtension = ".jpe" OR strImageFileExtension = ".bmp" OR strImageFileExtension = ".png") Then strInputEntry = Replace(strInputEntry, strImageFileExtension, "", 1, -1, 1) End If 'Call the format link function to strip malicious codes strInputEntry = formatLink(strInputEntry) 'Chop out any querystring question marks that maybe in the image link strInputEntry = Replace(strInputEntry, "?", "", 1, -1, 1) End If 'Return checkImages = strInputEntry End Function '****************************************** '*** Format user input ***** '****************************************** 'Format user input function Private Function formatInput(ByVal strInputEntry) 'Get rid of malicous code in the message strInputEntry = Replace(strInputEntry, "script", "script", 1, -1, 0) strInputEntry = Replace(strInputEntry, "SCRIPT", "SCRIPT", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Script", "Script", 1, -1, 0) strInputEntry = Replace(strInputEntry, "script", "Script", 1, -1, 1) strInputEntry = Replace(strInputEntry, "object", "object", 1, -1, 0) strInputEntry = Replace(strInputEntry, "OBJECT", "OBJECT", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Object", "Object", 1, -1, 0) strInputEntry = Replace(strInputEntry, "object", "Object", 1, -1, 1) strInputEntry = Replace(strInputEntry, "applet", "applet", 1, -1, 0) strInputEntry = Replace(strInputEntry, "APPLET", "APPLET", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Applet", "Applet", 1, -1, 0) strInputEntry = Replace(strInputEntry, "applet", "Applet", 1, -1, 1) strInputEntry = Replace(strInputEntry, "embed", "embed", 1, -1, 0) strInputEntry = Replace(strInputEntry, "EMBED", "EMBED", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Embed", "Embed", 1, -1, 0) strInputEntry = Replace(strInputEntry, "embed", "Embed", 1, -1, 1) strInputEntry = Replace(strInputEntry, "event", "event", 1, -1, 0) strInputEntry = Replace(strInputEntry, "EVENT", "EVENT", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Event", "Event", 1, -1, 0) strInputEntry = Replace(strInputEntry, "event", "Event", 1, -1, 1) strInputEntry = Replace(strInputEntry, "document", "document", 1, -1, 0) strInputEntry = Replace(strInputEntry, "DOCUMENT", "DOCUMENT", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Document", "Document", 1, -1, 0) strInputEntry = Replace(strInputEntry, "document", "Document", 1, -1, 1) strInputEntry = Replace(strInputEntry, "cookie", "cookie", 1, -1, 0) strInputEntry = Replace(strInputEntry, "COOKIE", "COOKIE", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Cookie", "Cookie", 1, -1, 0) strInputEntry = Replace(strInputEntry, "cookie", "Cookie", 1, -1, 1) strInputEntry = Replace(strInputEntry, "form", "form", 1, -1, 0) strInputEntry = Replace(strInputEntry, "FORM", "FORM", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Form", "Form", 1, -1, 0) strInputEntry = Replace(strInputEntry, "form", "Form", 1, -1, 1) strInputEntry = Replace(strInputEntry, "iframe", "iframe", 1, -1, 0) strInputEntry = Replace(strInputEntry, "IFRAME", "IFRAME", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Iframe", "Iframe", 1, -1, 0) strInputEntry = Replace(strInputEntry, "iframe", "iframe", 1, -1, 1) strInputEntry = Replace(strInputEntry, "textarea", "textarea", 1, -1, 0) strInputEntry = Replace(strInputEntry, "TEXTAREA", "TEXTAREA", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Textarea", "Textarea", 1, -1, 0) strInputEntry = Replace(strInputEntry, "textarea", "Textarea", 1, -1, 1) strInputEntry = Replace(strInputEntry, "on", "on", 1, -1, 0) strInputEntry = Replace(strInputEntry, "ON", "ON", 1, -1, 0) strInputEntry = Replace(strInputEntry, "On", "On", 1, -1, 0) strInputEntry = Replace(strInputEntry, "on", "on", 1, -1, 1) 'Reformat a few bits strInputEntry = Replace(strInputEntry, "", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "font", "font", 1, -1, 0) strInputEntry = Replace(strInputEntry, "FONT", "FONT", 1, -1, 0) strInputEntry = Replace(strInputEntry, "Font", "Font", 1, -1, 0) strInputEntry = Replace(strInputEntry, "fOnt", "font", 1, -1, 1) strInputEntry = Replace(strInputEntry, "font", "font", 1, -1, 1) strInputEntry = Replace(strInputEntry, "mono", "mono", 1, -1, 0) strInputEntry = Replace(strInputEntry, "MONO", "MONO", 1, -1, 0) strInputEntry = Replace(strInputEntry, "MOno", "Mono", 1, -1, 0) strInputEntry = Replace(strInputEntry, "mOno", "mono", 1, -1, 1) strInputEntry = Replace(strInputEntry, "mono", "mono", 1, -1, 1) 'Return formatInput = strInputEntry End Function '******************************************** '*** Format Links ***** '******************************************** 'Format links funtion Private Function formatLink(ByVal strInputEntry) 'Remove malisous charcters from links and images strInputEntry = Replace(strInputEntry, "document.cookie", ".", 1, -1, 1) strInputEntry = Replace(strInputEntry, "javascript:", "javascript ", 1, -1, 1) strInputEntry = Replace(strInputEntry, "vbscript:", "vbscript ", 1, -1, 1) strInputEntry = Replace(strInputEntry, "javascript :", "javascript ", 1, -1, 1) strInputEntry = Replace(strInputEntry, "vbscript :", "vbscript ", 1, -1, 1) strInputEntry = Replace(strInputEntry, "[", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "]", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "(", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, ")", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "{", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "}", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "<", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, ">", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "|", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "script", "script", 1, -1, 1) strInputEntry = Replace(strInputEntry, "object", "object", 1, -1, 1) strInputEntry = Replace(strInputEntry, "applet", "applet", 1, -1, 1) strInputEntry = Replace(strInputEntry, "embed", "embed", 1, -1, 1) strInputEntry = Replace(strInputEntry, "document", "document", 1, -1, 1) strInputEntry = Replace(strInputEntry, "cookie", "cookie", 1, -1, 1) strInputEntry = Replace(strInputEntry, "event", "event", 1, -1, 1) strInputEntry = Replace(strInputEntry, "on", "on", 1, -1, 1) 'Return formatLink = strInputEntry End Function '******************************************** '*** Format SQL input ***** '******************************************** 'Format SQL Query funtion Private Function formatSQLInput(ByVal strInputEntry) 'Remove malisous charcters from links and images strInputEntry = Replace(strInputEntry, "<", "<") strInputEntry = Replace(strInputEntry, ">", ">") strInputEntry = Replace(strInputEntry, """", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "=", "=", 1, -1, 1) strInputEntry = Replace(strInputEntry, "'", "''", 1, -1, 1) strInputEntry = Replace(strInputEntry, "select", "select", 1, -1, 1) strInputEntry = Replace(strInputEntry, "join", "join", 1, -1, 1) strInputEntry = Replace(strInputEntry, "union", "union", 1, -1, 1) strInputEntry = Replace(strInputEntry, "where", "where", 1, -1, 1) strInputEntry = Replace(strInputEntry, "insert", "insert", 1, -1, 1) strInputEntry = Replace(strInputEntry, "delete", "delete", 1, -1, 1) strInputEntry = Replace(strInputEntry, "update", "update", 1, -1, 1) strInputEntry = Replace(strInputEntry, "like", "like", 1, -1, 1) strInputEntry = Replace(strInputEntry, "drop", "drop", 1, -1, 1) strInputEntry = Replace(strInputEntry, "create", "create", 1, -1, 1) strInputEntry = Replace(strInputEntry, "modify", "modify", 1, -1, 1) strInputEntry = Replace(strInputEntry, "rename", "rename", 1, -1, 1) strInputEntry = Replace(strInputEntry, "alter", "alter", 1, -1, 1) strInputEntry = Replace(strInputEntry, "cast", "cast", 1, -1, 1) 'Return formatSQLInput = strInputEntry End Function '********************************************* '*** Strip all tags ***** '********************************************* 'Remove all tags for text only display (mainly for subject lines) Private Function removeAllTags(ByVal strInputEntry) 'Remove all HTML scripting tags etc. for plain text output strInputEntry = Replace(strInputEntry, "&", "&", 1, -1, 1) strInputEntry = Replace(strInputEntry, "<", "<", 1, -1, 1) strInputEntry = Replace(strInputEntry, ">", ">", 1, -1, 1) strInputEntry = Replace(strInputEntry, "'", "’", 1, -1, 1) 'Return removeAllTags = strInputEntry End Function '********************************************* '*** Decode HTML encoding ***** '********************************************* 'Decode encoded strings Private Function decodeString(ByVal strInputEntry) 'Remove malisous charcters from links and images strInputEntry = Replace(strInputEntry, "=", "=", 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, "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, "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, ">", ">", 1, -1, 0) strInputEntry = Replace(strInputEntry, "&", "&", 1, -1, 0) 'Return decodeString = strInputEntry End Function %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide ASP Discussion Forum '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Dimension variables Dim rsDateTimeFormat 'Holds the date a time data Dim saryDateTimeData(17) 'Holds the info for converting the date and time Dim intLoopCounter 'loop counter 'Craete a recordset to get the date and time format data Set rsDateTimeFormat = Server.CreateObject("ADODB.Recordset") 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "TimeAndDateSettings" Else strSQL = "SELECT " & strDbTable & "DateTimeFormat.* FROM " & strDbTable & "DateTimeFormat;" End If 'Query the database rsDateTimeFormat.Open strSQL, adoCon 'All the data is feed into an array from the recordset to be used later, this is done 'as some versions of MDAC will report an error if the recordset is opened in the functions 'below, if called a large number of times. 'If there are records returned then enter the data returned into an array If NOT rsDateTimeFormat.EOF Then 'Initilise the array 'Calculate which date format to use If strDateFormat <> "" Then saryDateTimeData(0) = strDateFormat Else saryDateTimeData(0) = rsDateTimeFormat("Date_format") End If saryDateTimeData(1) = rsDateTimeFormat("Year_format") saryDateTimeData(2) = rsDateTimeFormat("Seporator") 'Initialise the mounth part of the array in a loop to save writing it 12 times For intLoopCounter = 1 to 12 saryDateTimeData((intLoopCounter + 2)) = rsDateTimeFormat("Month" & (intLoopCounter)) Next saryDateTimeData(15) = rsDateTimeFormat("Time_format") saryDateTimeData(16) = rsDateTimeFormat("am") saryDateTimeData(17) = rsDateTimeFormat("pm") End If 'Relese server objects rsDateTimeFormat.Close Set rsDateTimeFormat = Nothing '****************************************** '*** Date Format ***** '****************************************** 'Function to format date Private Function DateFormat(ByVal dtmDate, ByVal saryDateTimeData) Dim strNewDate 'Holds the new date format Dim intDay 'Holds the integer number for the day Dim intMonth 'Holds a integer number from 1 to 12 for the month Dim strMonth 'Holds the month in it's final format which may be a number or a string so it is set to a sring value Dim intYear 'Holds the year Dim dtmTempDate 'Temprary storage area for date 'If the array is empty set the date as UK If isNull(saryDateTimeData) Then 'Set the date as orginal DateFormat = dtmDate 'If there is a data in the array then format the date Else 'Place the users time off set onto the recorded database time If strTimeOffSet = "+" Then dtmTempDate = DateAdd("h", + intTimeOffSet, dtmDate) ElseIf strTimeOffSet = "-" Then dtmTempDate = DateAdd("h", - intTimeOffSet, dtmDate) End If 'Seprate the date into differnet strings intDay = CInt(Day(dtmTempDate)) intMonth = CInt(Month(dtmTempDate)) intYear = CInt(Year(dtmTempDate)) 'Place 0 infront of days under 10 If intDay < 10 then intDay = "0" & intDay 'If the year is two digits then sorten the year string If saryDateTimeData(1) = "short" Then intYear = Right(intYear, 2) 'Format the month strMonth = saryDateTimeData((intMonth + 2)) 'Format the date Select Case saryDateTimeData(0) 'Format dd/mm/yy Case "dd/mm/yy" DateFormat = intDay & saryDateTimeData(2) & strMonth & saryDateTimeData(2) & intYear 'Format mm/dd/yy Case "mm/dd/yy" DateFormat = strMonth & saryDateTimeData(2) & intDay & saryDateTimeData(2) & intYear 'Format yy/dd/mm Case "yy/dd/mm" DateFormat = intYear & saryDateTimeData(2) & intDay & saryDateTimeData(2) & strMonth 'Format yy/mm/dd Case "yy/mm/dd" DateFormat = intYear & saryDateTimeData(2) & strMonth & saryDateTimeData(2) & intDay End Select End If End Function '****************************************** '*** Time Format ***** '****************************************** 'Function to format time Function TimeFormat(ByVal dtmTime, ByVal saryDateTimeData) Dim strNewDate 'Holds the new date format Dim intHour 'Holds the integer number for the hours Dim intMinute 'Holds a integer number for the mintes Dim strPeriod 'Holds wether it is am or pm Dim dtmTempTime 'Temporary storage area for the time 'If the array is empty then return tyhe original time If isNull(saryDateTimeData) Then 'Set the date as UK TimeFormat = dtmTime 'If there is a data in the array then format the date Else 'Place the users time off-set onto the recorded database time If strTimeOffSet = "+" Then dtmTempTime = DateAdd("h", + intTimeOffSet, dtmTime) ElseIf strTimeOffSet = "-" Then dtmTempTime = DateAdd("h", - intTimeOffSet, dtmTime) End If 'Seprate the time into differnet strings intHour = CInt(Hour(dtmTempTime)) intMinute = CInt(Minute(dtmTempTime)) 'Place 0 infront of minutes under 10 If intMinute < 10 then intMinute = "0" & intMinute 'If the time is 12 hours then change the time to 12 hour clock If CInt(saryDateTimeData(15)) = 12 Then 'Set the time period If intHour >= 12 then strPeriod = saryDateTimeData(17) Else strPeriod = saryDateTimeData(16) End If 'Change the hour to 12 hour clock time Select Case intHour Case 00 intHour = 12 Case 01 intHour = 1 Case 02 intHour = 2 Case 03 intHour = 3 Case 04 intHour = 4 Case 05 intHour = 5 Case 06 intHour = 6 Case 07 intHour = 7 Case 08 intHour = 8 Case 09 intHour = 9 Case 13 intHour = 1 Case 14 intHour = 2 Case 15 intHour = 3 Case 16 intHour = 4 Case 17 intHour = 5 Case 18 intHour = 6 Case 19 intHour = 7 Case 20 intHour = 8 Case 21 intHour = 9 Case 22 intHour = 10 Case 23 intHour = 11 End Select 'ElseIf it is 24 hour clock place another 0 infront of anything below 10 hours ElseIf intHour < 10 Then intHour = "0" & intHour End If 'Return the Formated time TimeFormat = intHour & ":" & intMinute & strPeriod End If End Function %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 Bruce Corkhill All Rights Reserved. '** '** This program is free 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 use parts of this program in your own private work, but 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 Web Wiz Guide and powered by logo's 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. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Set the response buffer to true as we maybe redirecting and setting a cookie Response.Buffer = True 'Make sure this page is not cached Response.Expires = -1 Response.ExpiresAbsolute = Now() - 2 Response.AddHeader "pragma","no-cache" Response.AddHeader "cache-control","private" Response.CacheControl = "No-Store" 'Dimension variables Dim rsCategory 'Holds the categories for the forums Dim rsForum 'Holds the Recordset for the forum details 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 strModeratorsList 'Holds a list of moderators for the forum Dim dtmForumStartDate 'Holds the forum start date 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 lngLastEntryTopicID 'Holds the topic 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 intForumReadRights 'Holds the interger number to calculate if the user has read rights on the forum Dim intForumPostRights 'Holds the interger valuse to calculate if the suer can poist in the forum Dim intForumReplyRights 'Holds the interger value to calculate if the user can reply to a post Dim blnHideForum 'Set to true if this is a hidden forum 'Initialise variables lngTotalNumberOfTopics = 0 lngTotalNumberOfPosts = 0 intNumberofForums = 0 intForumColourNumber = 0 'Craete a recordset to get the forum details Set rsCategory = Server.CreateObject("ADODB.Recordset") 'Read the various categories from the database 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "CategoryAll" Else strSQL = "SELECT " & strDbTable & "Category.Cat_name, " & strDbTable & "Category.Cat_ID FROM " & strDbTable & "Category ORDER BY " & strDbTable & "Category.Cat_order ASC;" End If 'Query the database rsCategory.Open strSQL, adoCon %> <% = strMainForumName %> <% Response.Write("

" & strTxtTheTimeNowIs & " " & DateFormat(now(), saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(now(), saryDateTimeData) & "
") 'If this is not the first time the user has visted the site display the last visit time and date If Session("dtmLastVisit") < CDate(Request.Cookies("FLVST")("LTVST")) Then Response.Write(strTxtYouLastVisitedOn & " " & DateFormat(Session("dtmLastVisit"), saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(Session("dtmLastVisit"), saryDateTimeData) & ".") End If %>

<% 'Check there are categories to display If rsCategory.EOF Then 'If there are no categories to display then display the appropriate error message Response.Write (vbCrLf & "") 'Else there the are categories so write the HTML to display categories and the forum names and a discription Else 'Create a recordset to get the forum details Set rsForum = Server.CreateObject("ADODB.Recordset") 'Loop round to read in all the categories in the database Do While NOT rsCategory.EOF 'Get the category name from the database strCategory = rsCategory("Cat_name") intCatID = CInt(rsCategory("Cat_ID")) 'Display the category name Response.Write vbCrLf & "" 'Read the various forums from the database 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumsAllWhereCatIs @intCatID = " & intCatID Else strSQL = "SELECT " & strDbTable & "Forum.* FROM " & strDbTable & "Forum WHERE " & strDbTable & "Forum.Cat_ID = " & intCatID & " ORDER BY " & strDbTable & "Forum.Forum_Order ASC;" End If 'Query the database rsForum.Open strSQL, adoCon 'Check there are forum's to display If rsForum.EOF Then 'If there are no forum's to display then display the appropriate error message Response.Write vbCrLf & "" 'Else there the are forum's to write the HTML to display it the forum names and a discription Else 'Loop round to read in all the forums in the database Do While NOT rsForum.EOF 'Initialise variables lngLastEntryTopicID = 0 strModeratorsList = "" 'Read in forum details from the database intForumID = CInt(rsForum("Forum_ID")) strForumName = rsForum("Forum_name") strForumDiscription = rsForum("Forum_description") dtmForumStartDate = CDate(rsForum("Date_Started")) strForumPassword = rsForum("Password") lngNumberOfPosts = CLng(rsForum("No_of_posts")) lngNumberOfTopics = CLng(rsForum("No_of_topics")) blnForumLocked = CBool(rsForum("Locked")) intForumReadRights = CInt(rsForum("Read")) intForumPostRights = CInt(rsForum("Post")) intForumReplyRights = CInt(rsForum("Reply_posts")) blnHideForum = CBool(rsForum("Hide")) 'Call the function to check the forum permissions Call forumPermisisons(intForumID, intGroupID, intForumReadRights, intForumPostRights, intForumReplyRights, 0, 0, 0, 0, 0, 0, 0) 'Add all the posts and topics together to get the total number for the stats at the bottom of the page lngTotalNumberOfPosts = lngTotalNumberOfPosts + lngNumberOfPosts lngTotalNumberOfTopics = lngTotalNumberOfTopics + lngNumberOfTopics 'If this forum is to be hidden and but the user is allowed access to it set the hidden boolen back to false If blnHideForum = True AND blnRead = True Then blnHideForum = False 'If the forum is to be hidden then don't show it If blnHideForum = False Then 'Get the row number intForumColourNumber = intForumColourNumber + 1 'Initilaise variables for the information required for each forum dtmLastEntryDate = dtmForumStartDate strLastEntryUser = strTxtForumAdministrator lngLastEntryUserID = 1 'Get the List of Group Moderators for the Forum If blnShowMod Then 'Initalise the strSQL variable with an SQL statement to query the database to get the moderators for this forum If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ModeratorGroup @intForumID = " & intForumID Else strSQL = "SELECT " & strDbTable & "Group.Group_ID, " & strDbTable & "Group.Name " strSQL = strSQL & "FROM " & strDbTable & "Group, " & strDbTable & "Permissions " strSQL = strSQL & "WHERE " & strDbTable & "Group.Group_ID = " & strDbTable & "Permissions.Group_ID AND " & strDbTable & "Permissions.Moderate = True AND " & strDbTable & "Permissions.Forum_ID = " & intForumID & ";" End If 'Query the database rsCommon.Open strSQL, adoCon 'Initlaise the Moderators List varible if there are records returned for the forum If NOT rsCommon.EOF Then strModeratorsList = "
" & strTxtModerators & ":" 'Loop round to build a list of moderators, if there are any Do While NOT rsCommon.EOF 'Place the moderators username into the string strModeratorsList = strModeratorsList & " " & rsCommon("Name") & "" 'Move to the next record rsCommon.MoveNext Loop 'Close the recordset rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database to get the moderators for this forum If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "Moderators @intForumID = " & intForumID Else strSQL = "SELECT " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Username " strSQL = strSQL & "FROM " & strDbTable & "Permissions, " & strDbTable & "Author " strSQL = strSQL & "WHERE " & strDbTable & "Author.Author_ID = " & strDbTable & "Permissions.Author_ID AND " & strDbTable & "Permissions.Moderate = True AND " & strDbTable & "Permissions.Forum_ID = " & intForumID & ";" End If 'Query the database rsCommon.Open strSQL, adoCon 'Initlaise the Moderators List varible if there are records returned for the forum If NOT rsCommon.EOF AND strModeratorsList = "" Then strModeratorsList = "
" & strTxtModerators & ":" 'Loop round to build a list of moderators, if there are any Do While NOT rsCommon.EOF 'Place the moderators username into the string strModeratorsList = strModeratorsList & " " & rsCommon("Username") & "" 'Move to the next record rsCommon.MoveNext Loop 'Close the recordset rsCommon.Close End If 'Initalise the strSQL variable with an SQL statement to query the database for the date of the last entry and the author for the thread If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "LastForumPostEntry @intForumID = " & intForumID Else strSQL = "SELECT Top 1 " & strDbTable & "Author.Username, " & strDbTable & "Author.Author_ID, " & strDbTable & "Thread.Topic_ID, " & strDbTable & "Thread.Thread_ID, " & strDbTable & "Thread.Message_date " strSQL = strSQL & "FROM " & strDbTable & "Author, " & strDbTable & "Thread " strSQL = strSQL & "WHERE " & strDbTable & "Author.Author_ID = " & strDbTable & "Thread.Author_ID AND " & strDbTable & "Thread.Topic_ID IN " strSQL = strSQL & " (SELECT TOP 1 " & strDbTable & "Topic.Topic_ID " strSQL = strSQL & " FROM " & strDbTable & "Topic " strSQL = strSQL & " WHERE " & strDbTable & "Topic.Forum_ID = " & intForumID & " " strSQL = strSQL & " ORDER BY " & strDbTable & "Topic.Last_entry_date DESC) " strSQL = strSQL & "ORDER BY " & strDbTable & "Thread.Message_date DESC;" End If 'Query the database rsCommon.Open strSQL, adoCon 'If there are threads for topic then read in the date and author of the last entry If NOT rsCommon.EOF Then 'Read in the deatils from the recorset of the last post details lngLastEntryMeassgeID = CLng(rsCommon("Thread_ID")) lngLastEntryTopicID = CLng(rsCommon("Topic_ID")) dtmLastEntryDate = CDate(rsCommon("Message_date")) strLastEntryUser = rsCommon("Username") lngLastEntryUserID = CLng(rsCommon("Author_ID")) End If 'Reset variables rsCommon.Close 'Calculate the last forum entry across all forums for the statistics at the bottom of the forum If dtmLastEntryDateAllForums < dtmLastEntryDate Then dtmLastEntryDateAllForums = dtmLastEntryDate strLastEntryUserAllForums = strLastEntryUser lngLastEntryUserIDAllForums = lngLastEntryUserID End If 'Write the HTML of the forum descriptions and hyperlinks to the forums Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") End If 'Count the number of forums intNumberofForums = intNumberofForums + 1 'Move to the next database record rsForum.MoveNext 'Loop back round for next forum Loop End If 'Close recordsets rsForum.Close 'Move to the next database record rsCategory.MoveNext 'Loop back round for next category Loop End If 'Release server variables rsCategory.Close Set rsCategory = Nothing Set rsForum = Nothing %>

	<% = strTxtForum %>	<% = strTxtTopics %>	<% = strTxtPosts %>	<% = strTxtLastPost %>
" & strTxtNoForums & "
" & strCategory & "
" & strTxtNoForums & "
") 'If the user has no access to a forum diplay a no access icon If blnRead = False AND blnModerator = False AND blnAdmin = False Then Response.Write (" ") 'If the forum requires a password diplay the password icon ElseIf strForumPassword <> "" Then Response.Write (" ") 'If the forum is read only and has new posts show the locked new posts icon ElseIf CDate(Session("dtmLastVisit")) < dtmLastEntryDate AND (blnForumLocked = True) AND blnAdmin = False AND blnModerator = False Then Response.Write (" ") 'If the forum is read only show the locked new posts icon ElseIf blnForumLocked Then Response.Write (" ") 'If the forum has new posts show the new posts icon ElseIf CDate(Session("dtmLastVisit")) < dtmLastEntryDate Then Response.Write (" ") 'If the forum is open but with no new replies Else Response.Write (" ") End If Response.Write(vbCrLf & "	") 'If this is the forum admin then let them have access to the forum admin pop up window If blnAdmin Then Response.Write(" ") Response.Write(vbCrLf & " " & strForumName & " " & strForumDiscription & strModeratorsList & "	" & lngNumberOfTopics & "	" & lngNumberOfPosts & "	" & DateFormat(dtmLastEntryDate, saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(dtmLastEntryDate, saryDateTimeData) & "") Response.Write(vbCrLf & " " & strTxtBy & " " & strLastEntryUser & "

<% = strTxtForumStatistics %>

<% Response.Write(vbCrLf & " " & strTxtOurUserHavePosted & " " & lngTotalNumberOfPosts & " " & strTxtPostsIn & " " & lngTotalNumberOfTopics & " " & strTxtTopicsIn & " " & intNumberofForums & " " & strTxtForums) Response.Write(vbCrLf & "
" & strTxtLastPostOn & " " & DateFormat(dtmLastEntryDateAllForums, saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(dtmLastEntryDateAllForums, saryDateTimeData) & " " & strTxtBy & " " & strLastEntryUserAllForums & "") 'Get the latest forum posts 'Cursor type to one to count rsCommon.CursorType = 1 'Get the last signed up user 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "AuthorDesc" Else strSQL = "SELECT " & strDbTable & "Author.Username, " & strDbTable & "Author.Author_ID " strSQL = strSQL & "FROM " & strDbTable & "Author " strSQL = strSQL & "ORDER BY " & strDbTable & "Author.Author_ID DESC;" End If 'Query the database rsCommon.Open strSQL, adoCon 'Display some statistics for the members If NOT rsCommon.EOF Then Response.Write(vbCrLf & "
" & strTxtWeHave & " " & rsCommon.RecordCount & " " & strTxtForumMembers) Response.Write(vbCrLf & "
" & strTxtTheNewestForumMember & " " & rsCommon("Username") & "") End If 'Close the recordset rsCommon.Close 'Get the number of active users if enabled If blnActiveUsers Then 'Initialise the SQL variable with an SQL statement count the number of records If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "CountOfActiveUsers" Else strSQL = "SELECT Count(" & strDbTable & "ActiveUser.Author_ID) AS ActiveUser From " & strDbTable & "ActiveUser;" End If 'Query the database rsCommon.Open strSQL, adoCon 'Read in the active users from the recordset intActiveUsers = CInt(rsCommon("ActiveUser")) 'Close the recordset rsCommon.Close 'Get the number of active guests 'Initialise the SQL variable with an SQL statement count the number of records If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "CountOfActiveGuests" Else strSQL = "SELECT Count(" & strDbTable & "ActiveUser.Author_ID) AS ActiveUser From " & strDbTable & "ActiveUser WHERE " & strDbTable & "ActiveUser.Author_ID=2;" End If 'Query the database rsCommon.Open strSQL, adoCon 'Read in the active guests from the recordset intActiveGuests = CInt(rsCommon("ActiveUser")) 'To save another database hit we can get the number of members online by taking the number of guest away from the total active users intActiveMembers = intActiveUsers - intActiveGuests 'Close the recordset rsCommon.Close Response.Write(vbCrLf & "
" & strTxtInTotalThereAre & " " & intActiveUsers & " " & strTxtActiveUsers & " " & strTxtOnLine & ", " & intActiveGuests & " " & strTxtGuestsAnd & " " & intActiveMembers & " " & strTxtMembers) End If %>

<% 'Reset Server Objects Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing %>

<% = strTxtOpenForum %>	<% = strTxtReadOnly %>	<% = strTxtPasswordRequired %>
<% = strTxtOpenForumNewReplies %>	<% = strTxtReadOnlyNewReplies %>	<% = strTxtNoAccess %>

<% = strTxtMarkAllPostsAsRead %> :: <% = strTxtDeleteCookiesSetByThisForum %>

<% = strTxtCookies %>

<% '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** If blnLCode = True Then If blnTextLinks = True Then Response.Write("Powered by Web Wiz Forums version " & strVersion & "") Else Response.Write("") End If Response.Write("
Copyright ©2001-2003 Web Wiz Guide") End If '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 'Display the process time If blnShowProcessTime Then Response.Write "

" & strTxtThisPageWasGeneratedIn & " " & FormatNumber(Timer() - dblStartTime, 4) & " " & strTxtSeconds & "" %>