<% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2004 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 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 strUsername 'Holds the users username Dim strPassword 'Holds the new users password Dim strUserCode 'Holds the unique user code for the user Dim strEmail 'Holds the new users e-mail address Dim blnSubscribeMailingList Dim intUsersGroupID 'Holds the users group ID Dim blnShowEmail 'Boolean set to true if the user wishes there e-mail address to be shown Dim strLocation 'Holds the new users location Dim strHomepage 'Holds the new users homepage if they have one Dim strAvatar 'Holds the avatar image Dim strCheckUsername 'Holds the usernames from the database recordset to check against the new users requested username Dim blnAutoLogin 'Boolean set to true if the user wants auto login trured on Dim strImageFileExtension 'holds the file extension Dim blnAccountReactivate 'Set to true if the users account needs to be reactivated Dim blnSentEmail 'Set to true if the e-mail has been sent Dim strEmailBody 'Holds the body of the welcome message e-mail Dim strSubject 'Holds the subject of the e-mail Dim strSignature 'Holds the signature Dim intForumID 'Holds the forum ID if within a forum Dim strICQNum 'Holds the users ICQ Number Dim strAIMAddress 'Holds the users AIM address Dim strMSNAddress 'Holds the users MSN address Dim strYahooAddress 'Holds the users Yahoo Address Dim strOccupation 'Holds the users Occupation Dim strInterests 'Holds the users Interests Dim dtmDateOfBirth 'Holds the users Date Of Birth Dim blnPMNotify 'Set to true if the user want email notification of PM's Dim strSmutWord 'Holds the smut word to give better performance so we don't need to keep grabbing it form the recordset Dim strSmutWordReplace 'Holds the smut word to be replaced with Dim strMode 'Holds the mode of the page Dim blnEmailOK 'Set to true if e-mail is not already in the database Dim blnUsernameOK 'Set to true if the username requested does not already exsist Dim intForumStartingGroup 'Holds the forum starting group ID number Dim strSalt 'Holds the salt value for the password Dim strEncryptedPassword 'Holds the encrypted password Dim blnPasswordChange 'Holds if the password is changed or not Dim blnEmailBlocked 'set to true if the email address is blocked Dim strCheckEmailAddress 'Holds the email address to be checked Dim lngUserProfileID 'Holds the users ID of the profile to get Dim blnAdminMode 'Set to true if admin mode is enabled to update other members profiles Dim blnUserActive 'Set to true if the users membership is active Dim lngPosts 'Holds the number of posts the user has made Dim intDOBYear 'Holds the year of birth Dim intDOBMonth 'Holds the month of birth Dim intDOBDay 'Holds the day of birth Dim strRealName 'Holds the persons real name Dim strMemberTitle 'Holds the members title Dim dtmServerTime 'Holds the current server time Dim lngLoopCounter 'Holds the generic loop counter for page Dim intUpdatePartNumber 'If an update holds which part to update Dim blnSecurityCodeOK 'Set to true if the security code is OK Dim strConfirmPassword 'Holds the users old password Dim blnConfirmPassOK 'Set to false if the conformed pass is not OK 'Initalise variables blnUsernameOK = True blnSecurityCodeOK = True blnEmailOK = True blnShowEmail = False blnAutoLogin = True blnAccountReactivate = False blnWYSIWYGEditor = True blnAttachSignature = True blnPasswordChange = False blnEmailBlocked = False blnAdminMode = False lngUserProfileID = lngLoggedInUserID blnConfirmPassOK = true '****************************************** '*** Read in page setup *** '****************************************** 'read in the forum ID number If isNumeric(Request.QueryString("FID")) Then intForumID = CInt(Request.QueryString("FID")) Else intForumID = 0 End If 'Read in the mode of the page strMode = Trim(Mid(Request.Form("mode"), 1, 7)) 'Also see if the admin mode is enabled If Request("M") = "A" Then blnAdminMode = True 'Check which page part we are displaying and updating if not all If Request("FPN") Then intUpdatePartNumber = CInt(Request("FPN")) Else intUpdatePartNumber = 0 End If '****************************************** '*** See if this is a new registration *** '****************************************** 'If this is a new registration check the user has accepted the terms of the forum 'Redirect if not been through the registration process If Request.Form("Reg") <> "OK" AND strMode = "reg" Then 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect Response.Redirect("registration_rules.asp?FID=" & intForumID) End If 'Check the user is not registered already and just hitting back on their browser If (strMode = "new" OR strMode = "reg") AND intGroupID <> 2 Then strMode = "" '****************************************** '*** Check permision to view page *** '****************************************** 'If the user his not activated their mem If blnActiveMember = False Then 'clean up before redirecting Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?M=ACT") End If 'If the user has not logged in or not a new registration then redirect them to the insufficient permissions page If (intGroupID = 2) AND NOT (strMode = "reg" OR strMode = "new") Then 'clean up before redirecting Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?Redirect=" & RedirectOmitPath("Redirect", True)) End If '******************************************** '*** Check and setup page for admin mode *** '******************************************** 'If the admin mode is enabled see if the user is an admin or moderator If blnAdminMode Then 'First see if the user is in a moderator group for any forum If blnAdmin = False Then 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT " & strDBTablePermissions & ".Moderate " strSQL = strSQL & "FROM " & strDBTablePermissions & " " If strDatabaseType = "SQLServer" Then strSQL = strSQL & "WHERE " & strDBTablePermissions & ".Group_ID = " & intGroupID & " AND " & strDBTablePermissions & ".Moderate = 1;" Else strSQL = strSQL & "WHERE " & strDBTablePermissions & ".Group_ID = " & intGroupID & " AND " & strDBTablePermissions & ".Moderate = True;" End If 'Query the database rsCommon.Open strSQL, adoCon 'If a record is returned then the user is a moderator in one of the forums If NOT rsCommon.EOF Then blnModerator = True 'Clean up rsCommon.Close End If 'Get the profile ID to edit lngUserProfileID = CLng(Request("PF")) 'Turn off email activation if it is enabled as it's not required for an admin edit of a profile blnEmailActivation = False 'If the user is not permitted in to use admin mode send 'em away If (blnAdmin = False AND blnModerator = False) 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) End If End If '****************************************** '*** Redirect to delete member page *** '****************************************** 'If the admin has selected to delete the account that is being edited then delete it If blnAdminMode AND blnAdmin AND strMode = "update" AND Request.Form("delete") Then 'clean up before redirecting Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'redirect to the deletion file Response.Redirect("delete_member.asp?MID=" & lngUserProfileID) End If '****************************************** '*** Update or create new member *** '****************************************** 'If the Profile has already been edited then update the Profile If strMode = "update" OR strMode = "new" Then '****************************************** '*** Check the session ID *** '****************************************** Call checkSessionID(Request.Form("sessionID")) '****************************************** '*** Check security code *** '****************************************** If strMode = "new" AND Session("lngSecurityCode") <> Trim(Mid(Request.Form("securityCode"), 1, 6)) Then 'Set the security code OK variable to false blnSecurityCodeOK = False End If '****************************************** '*** Read in member details from form *** '****************************************** 'Read in the users details from the form If strMode = "new" OR blnAdmin Then strUsername = Trim(Mid(Request.Form("name"), 1, intMaxUsernameLength)) strUsername = Server.HTMLEncode(strUsername) 'If part number = 0 (all) or part 1 (reg details) then run this code If intUpdatePartNumber = 0 OR intUpdatePartNumber = 1 Then strPassword = LCase(Trim(Mid(Request.Form("password"), 1, 15))) strConfirmPassword = LCase(Trim(Mid(Request.Form("oldPass"), 1, 15))) strEmail = Trim(Mid(Request.Form("email"), 1, 60)) End If 'If part number = 0 (all) or part 2 (profile details) then run this code If intUpdatePartNumber = 0 OR intUpdatePartNumber = 2 Then blnSubscribeMailingList = CBool(Request.Form("mailing_list")) strRealName = Trim(Mid(Request.Form("realName"), 1, 27)) strLocation = Trim(Mid(Request.Form("location"), 1, 40)) strHomepage = Trim(Mid(Request.Form("homepage"), 1, 48)) strSignature = Mid(Request.Form("signature"), 1, 200) blnAttachSignature = CBool(Request.Form("attachSig")) 'Check that the ICQ number is a number before reading it in If isNumeric(Request.Form("ICQ")) Then strICQNum = Trim(Mid(Request.Form("ICQ"), 1, 15)) strAIMAddress = Trim(Mid(Request.Form("AIM"), 1, 60)) strMSNAddress = Trim(Mid(Request.Form("MSN"), 1, 60)) strYahooAddress = Trim(Mid(Request.Form("Yahoo"), 1, 60)) strOccupation = Mid(Request.Form("occupation"), 1, 40) strInterests = Mid(Request.Form("interests"), 1, 130) 'Check the date of birth is a date before entering it If Request.Form("DOBday") <> 0 AND Request.Form("DOBmonth") <> 0 AND Request.Form("DOByear") <> 0 Then dtmDateOfBirth = CDate(DateSerial(Request.Form("DOByear"), Request.Form("DOBmonth"), Request.Form("DOBday"))) End If End If 'If part number = 0 (all) or part 3 (forum preferences) then run this code If intUpdatePartNumber = 0 OR intUpdatePartNumber = 3 Then blnShowEmail = CBool(Request.Form("emailShow")) blnPMNotify = CBool(Request.Form("pmNotify")) blnAutoLogin = CBool(Request.Form("Login")) strDateFormat = Trim(Mid(Request.Form("dateFormat"), 1, 10)) strTimeOffSet = Trim(Mid(Request.Form("serverOffSet"), 1, 1)) intTimeOffSet = CInt(Request.Form("serverOffSetHours")) blnReplyNotify = CBool(Request.Form("replyNotify")) blnWYSIWYGEditor = CBool(Request.Form("ieEditor")) End If 'If we are in admin mode read in some extras (unless the admin or guest accounts) If blnAdminMode Then If lngUserProfileID > 2 Then blnUserActive = CBool(Request.Form("active")) If lngUserProfileID > 2 Then intUsersGroupID = CInt(Request.Form("group")) If isNumeric(Request.Form("posts")) Then lngPosts = CLng(Request.Form("posts")) strMemberTitle = Trim(Mid(Request.Form("memTitle"), 1, 40)) End If '****************************************** '*** Read in the avatar *** '****************************************** 'If avatars are enabled then read in selected avatar If blnAvatar = True AND (intUpdatePartNumber = 0 OR intUpdatePartNumber = 2) Then strAvatar = Trim(Mid(Request.Form("txtAvatar"), 1, 95)) 'If the avatar text box is empty then read in the avatar from the list box If strAvatar = "http://" OR strAvatar = "" Then strAvatar = Trim(Request.Form("SelectAvatar")) 'If there is no new avatar selected then get the old one if there is one If strAvatar = "" Then strAvatar = Request.Form("oldAvatar") 'If the avatar is the blank image then the user doesn't want one If strAvatar = strImagePath & "blank.gif" Then strAvatar = "" Else strAvatar = "" End If '****************************************** '*** Clean up member details *** '****************************************** 'Clean up user input 'If part number = 0 (all) or part 2 (profile details) then run this code If intUpdatePartNumber = 0 OR intUpdatePartNumber = 2 Then strRealName = removeAllTags(strRealName) strRealName = formatInput(strRealName) strHomepage = formatLink(strHomepage) strHomepage = formatInput(strHomepage) strLocation = removeAllTags(strLocation) strLocation = formatInput(strLocation) strAIMAddress = formatLink(strAIMAddress) strAIMAddress = formatInput(strAIMAddress) strMSNAddress = formatLink(strMSNAddress) strMSNAddress = formatInput(strMSNAddress) strYahooAddress = formatLink(strYahooAddress) strYahooAddress = formatInput(strYahooAddress) strOccupation = removeAllTags(strOccupation) strOccupation = formatInput(strOccupation) strInterests = removeAllTags(strInterests) strInterests = formatInput(strInterests) 'Call the function to format the signature strSignature = FormatPost(strSignature) 'Call the function to format forum codes strSignature = FormatForumCodes(strSignature) 'Call the filters to remove malcious HTML code strSignature = checkHTML(strSignature) 'Strip long text strings from signature strSignature = removeLongText(strSignature) 'If the user has not entered a hoempage then make sure the homepage variable is blank If strHomepage = "http://" Then strHomepage = "" End If strDateFormat = removeAllTags(strDateFormat) strDateFormat = formatInput(strDateFormat) strMemberTitle = removeAllTags(strMemberTitle) strMemberTitle = formatInput(strMemberTitle) 'SQL safe format call strEmail = formatSQLInput(strEmail) 'Remove any single quotes as they should not be in email addresses strEmail = Replace(strEmail, "'", "", 1, -1, 1) '****************************************** '*** Check the avatar is OK *** '****************************************** 'Remove malicious code form the avatar link or remove it all togtaher if not a web graphic If strAvatar <> "" Then 'If there is no . in the link then there is no extenison and so can't be an image If inStr(1, strAvatar, ".", 1) = 0 Then strAvatar = "" 'Else remove malicious code and check the extension is an image extension Else 'Call the filter for the image strAvatar = checkImages(strAvatar) strAvatar = formatInput(strAvatar) End If End If '****************************************** '*** Check the username is OK *** '****************************************** 'If this is a new reg clean up the username If strMode = "new" OR blnAdmin Then 'Check there is a username If strUsername = "" Then blnUsernameOK = False 'Make sure the user has not entered disallowed usernames If InStr(1, strUsername, "admin", vbTextCompare) Then blnUsernameOK = False If InStr(1, strUsername, "password", vbTextCompare) Then blnUsernameOK = False If InStr(1, strUsername, "salt", vbTextCompare) Then blnUsernameOK = False If InStr(1, strUsername, "author", vbTextCompare) Then blnUsernameOK = False If InStr(1, strUsername, "code", vbTextCompare) Then blnUsernameOK = False If InStr(1, strUsername, "username", vbTextCompare) Then blnUsernameOK = False If InStr(1, strUsername, "N0act", vbTextCompare) Then blnUsernameOK = False 'Clean up user input strUsername = formatSQLInput(strUsername) End If '****************************************** '*** Remove bad words *** '****************************************** 'Replace swear words with other words with *** 'Initalise the SQL string with a query to read in all the words from the smut table strSQL = "SELECT " & strDbTable & "Smut.* FROM " & strDbTable & "Smut;" 'Open the recordset rsCommon.Open strSQL, adoCon 'Loop through all the words to check for Do While NOT rsCommon.EOF 'Read in the smut words strSmutWord = rsCommon("Smut") strSmutWordReplace = rsCommon("Word_replace") 'Replace the swear words with the words in the database the swear words If strMode = "new" OR blnAdmin Then strUsername = Replace(strUsername, strSmutWord, strSmutWordReplace, 1, -1, 1) strRealName = Replace(strRealName, strSmutWord, strSmutWordReplace, 1, -1, 1) strSignature = Replace(strSignature, strSmutWord, strSmutWordReplace, 1, -1, 1) strAIMAddress = Replace(strAIMAddress, strSmutWord, strSmutWordReplace, 1, -1, 1) strMSNAddress = Replace(strMSNAddress, strSmutWord, strSmutWordReplace, 1, -1, 1) strYahooAddress = Replace(strYahooAddress, strSmutWord, strSmutWordReplace, 1, -1, 1) strOccupation = Replace(strOccupation, strSmutWord, strSmutWordReplace, 1, -1, 1) strInterests = Replace(strInterests, strSmutWord, strSmutWordReplace, 1, -1, 1) 'Move to the next word in the recordset rsCommon.MoveNext Loop 'Release the smut recordset object rsCommon.Close '****************************************** '*** Check input if new reg *** '****************************************** 'If this is a new reg then check the username and genrate usercode, setup email activation etc. If strMode = "new" OR blnAdmin Then '****************************************** '*** Check the username is availabe *** '****************************************** 'If the username is not already written off then check it's not already gone If blnUsernameOK Then 'Read in the the usernames from the database to check that the username does not already exsist 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT " & strDbTable & "Author.Username FROM " & strDbTable & "Author WHERE " & strDbTable & "Author.Username = '" & strUsername & "';" 'Query the database rsCommon.Open strSQL, adoCon 'If there is a record returned from the database then the username is already used If NOT rsCommon.EOF Then blnUsernameOK = False 'Close the recordset rsCommon.Close 'Remove SQL safe single quote double up set in the format SQL function strUsername = Replace(strUsername, "''", "'", 1, -1, 1) '****************************************** '*** Get the starting group ID *** '****************************************** 'Get the starting group ID number 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "SELECT " & strDbTable & "Group.Group_ID FROM " & strDbTable & "Group WHERE " & strDbTable & "Group.Starting_group = 1;" Else strSQL = "SELECT " & strDbTable & "Group.Group_ID FROM " & strDbTable & "Group WHERE " & strDbTable & "Group.Starting_group = true;" End If 'Query the database rsCommon.Open strSQL, adoCon 'Get the forum starting group ID number intForumStartingGroup = CInt(rsCommon("Group_ID")) 'Close the recordset rsCommon.Close End If '****************************************** '*** Check email domain is not banned *** '****************************************** 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT " & strDbTable & "BanList.Email FROM " & strDbTable & "BanList WHERE " & strDbTable & "BanList.Email Is Not Null;" 'Query the database rsCommon.Open strSQL, adoCon 'Loop through the email address and check 'em out Do while NOT rsCommon.EOF 'Read in the email address to check strCheckEmailAddress = rsCommon("Email") 'If a whildcard character is found then check that If Instr(1, strCheckEmailAddress, "*", 1) > 0 Then 'Remove the wildcard charcter from the email address to check strCheckEmailAddress = Replace(strCheckEmailAddress, "*", "", 1, -1, 1) 'Use the same filters as that on the email address being checked strCheckEmailAddress = formatLink(strCheckEmailAddress) strCheckEmailAddress = formatInput(strCheckEmailAddress) 'If the banned email and the email entered match up then don't let em sign up If InStr(1, strEmail, strCheckEmailAddress, 1) Then blnEmailBlocked = True 'Else check the actual name doesn't match Else 'Use the same filters as that on the email address being checked strCheckEmailAddress = formatLink(strCheckEmailAddress) strCheckEmailAddress = formatInput(strCheckEmailAddress) 'If the banned email and the email entered match up then don't let em sign up If strCheckEmailAddress = strEmail Then blnEmailBlocked = True End If 'Move to the next record rsCommon.MoveNext Loop 'Close recordset rsCommon.Close '****************************************** '*** Check email address is availabe *** '****************************************** 'If e-mail activation is on then check the email address is not already used If blnEmailActivation Then 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT " & strDbTable & "Author.Author_email FROM " & strDbTable & "Author WHERE " & strDbTable & "Author.Author_email = '" & strEmail & "';" 'Query the database rsCommon.Open strSQL, adoCon 'If there is a record returned from the database then the email address is already used If NOT rsCommon.EOF Then blnEmailOK = False 'Close recordset rsCommon.Close End If '****************************************** '*** Create a usercode *** '****************************************** 'Calculate a code for the user strUserCode = userCode(strUsername) '****************************************** '*** If update, update usercode *** '****************************************** 'Else this is an update so just calculate a new usercode Else 'Calculate a new code for the user strUserCode = userCode(strLoggedInUsername) End If '****************************************** '*** Read in user details from database *** '****************************************** 'Intialise the strSQL variable with an SQL string to open a record set for the Author table If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "AuthorDetails @lngUserID = " & lngUserProfileID Else strSQL = "SELECT " & strDbTable & "Author.* " strSQL = strSQL & "FROM " & strDbTable & "Author " strSQL = strSQL & "WHERE " & strDbTable & "Author.Author_ID = " & lngUserProfileID End If 'Set the cursor type property of the record set to Dynamic so we can navigate through the record set rsCommon.CursorType = 2 'Set the Lock Type for the records so that the record set is only locked when it is updated rsCommon.LockType = 3 'Open the author table rsCommon.Open strSQL, adoCon '******************************************** '*** Update the usercode if in admin mode *** '******************************************** 'If there is a record and in admin mode update the user code to activate or suspend the member If NOT rsCommon.EOF AND blnAdminMode Then 'Read in the usercode to check incase we are suspending or unsuspending the account strUserCode = rsCommon("User_code") 'If we are suspoending the user account and it doesn't alerady contain a suspended code then add it If blnUserActive = False AND InStr(1, strUserCode, "N0act", vbTextCompare) = False AND lngUserProfileID > 2 Then strUserCode = strUserCode & "N0act" 'Else remove any suspended stuff from the usercode ElseIf blnUserActive Then strUserCode = Replace(strUserCode, "N0act", "", 1, -1, 1) End If End If '******************************************** '*** Don't let moderator update admin mem *** '******************************************** 'Once the author table is open if this is an update and admin mode is on and the updater is a moderator check that the account being updated is not an admin account If strMode = "update" AND blnAdminMode AND blnModerator AND NOT rsCommon.EOF Then 'If the account being updated is an admin account and the updater is only a moderator then send 'em away If CInt(rsCommon("Group_ID")) = 1 Then 'clean up before redirecting rsCommon.Close Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?FID=" & intForumID) End If End If '****************************************** '*** Encrypt password *** '****************************************** 'Encrypt password If blnEncryptedPasswords Then If strPassword <> "" Then 'If this is a new reg then generate a salt value If strMode = "new" Then strSalt = getSalt(Len(strPassword)) 'Else this is an update so get the salt value from the db Else strSalt = rsCommon("Salt") End If 'Concatenate salt value to the password strEncryptedPassword = strPassword & strSalt strConfirmPassword = strConfirmPassword & strSalt 'Encrypt the password strEncryptedPassword = HashEncode(strEncryptedPassword) strConfirmPassword = HashEncode(strConfirmPassword) End If 'Else the password is not set to be encrypted so place the un-encrypted password into the strEncryptedPassword variable Else strEncryptedPassword = strPassword End If '****************************************** '*** Update password *** '****************************************** 'If this is an update then check the user has not change their password If strMode = "update" AND strPassword <> "" Then 'Check the old password matches that of the confirmed password If strConfirmPassword <> rsCommon("Password") AND blnAdminMode = false Then blnConfirmPassOK = false 'If the password doesn't match that stored in the db then this is a password update If rsCommon("Password") <> strEncryptedPassword AND blnConfirmPassOK Then 'Generate new salt strSalt = getSalt(Len(strPassword)) 'Concatenate salt value to the password strEncryptedPassword = strPassword & strSalt 'Re-Genreate encypted password with new salt value If blnEncryptedPasswords Then strEncryptedPassword = HashEncode(strEncryptedPassword) 'Set the changed password boolean to true blnPasswordChange = True End If End If '****************************************** '*** Check for email update *** '****************************************** 'If e-mail activation is on then check the user has not changed there e-mail address If blnEmailActivation AND blnAdmin = False AND (strMode = "update" AND (intUpdatePartNumber = 1 OR intUpdatePartNumber = 0)) Then 'If the old and new e-mail addresses don't match set the reactivation boolean to true If rsCommon("Author_email") <> strEmail Then blnAccountReactivate = True End If '****************************************** '*** Update datbase *** '****************************************** 'If this is new reg and the username and email is OK or this is an update then register the new user or update the rs If (strMode = "new" AND blnUsernameOK AND blnEmailOK AND blnSecurityCodeOK AND blnEmailBlocked = False) OR (strMode = "update" AND blnConfirmPassOK) Then 'If this is new then create a new rs and reset session variable If strMode = "new" Then Session("lngSecurityCode") = null rsCommon.AddNew End If 'Insert the user's details into the rs With rsCommon If strMode = "new" OR blnAdmin AND strUsername <> "" Then .Fields("Username") = strUsername If strMode = "new" Then .Fields("Group_ID") = intForumStartingGroup 'If part number = 0 (all) or part 1 (reg details) then run this code If intUpdatePartNumber = 0 OR intUpdatePartNumber = 1 Then If (strMode = "update" AND blnPasswordChange = True) OR strMode = "new" Then .Fields("Password") = strEncryptedPassword If (strMode = "update" AND blnPasswordChange = True) OR strMode = "new" Then .Fields("Salt") = strSalt .Fields("User_code") = strUserCode .Fields("Author_email") = strEmail End If 'If part number = 0 (all) or part 2 (profile details) then run this code If intUpdatePartNumber = 0 OR intUpdatePartNumber = 2 Then .Fields("Real_name") = strRealName .Fields("Location") = strLocation .Fields("Avatar") = strAvatar 'If this is new reg then don't include profile info in the add new If (blnLongRegForm AND strMode = "new") OR strMode <> "new" Then .Fields("Mailing_list") = blnSubscribeMailingList .Fields("Homepage") = strHomepage .Fields("ICQ") = strICQNum .Fields("AIM") = strAIMAddress .Fields("MSN") = strMSNAddress .Fields("Yahoo") = strYahooAddress .Fields("Occupation") = strOccupation .Fields("Interests") = strInterests .Fields("DOB") = dtmDateOfBirth .Fields("Signature") = strSignature .Fields("Attach_signature") = blnAttachSignature Else .Fields("Attach_signature") = true End If End If 'If part number = 0 (all) or part 3 (forum preferences) then run this code If intUpdatePartNumber = 0 OR intUpdatePartNumber = 3 Then .Fields("Date_format") = strDateFormat .Fields("Time_offset") = strTimeOffSet .Fields("Time_offset_hours") = intTimeOffSet .Fields("Reply_notify") = blnReplyNotify .Fields("Rich_editor") = blnWYSIWYGEditor .Fields("PM_notify") = blnPMNotify .Fields("Show_email") = blnShowEmail End If 'If the e-mail activation is on and this is a new reg or an update and the account needs reactivating then don't activate the account If ((blnEmailActivation = True AND strMode = "new") OR blnAccountReactivate = True) AND blnModerator = False Then .Fields("Active") = 0 Else .Fields("Active") = 1 End If 'If the admin mode is enabled then add update some extra parts If blnAdminMode AND (blnAdmin Or blnModerator) AND strMode = "update" Then If lngUserProfileID > 2 Then .Fields("Active") = blnUserActive .Fields("Avatar_title") = strMemberTitle If isEmpty(lngPosts) = False Then .Fields("No_of_posts") = lngPosts 'If the user is also the admin then let them update some other parts If blnAdmin AND lngUserProfileID > 2 Then .Fields("Group_ID") = intUsersGroupID End If End If 'Update the database with the new user's details (needed for MS Access which can be slow updating) .Update 'Re-run the query to read in the updated recordset from the database .Requery End With '****************************************** '*** Create usercode cookie *** '****************************************** 'Write a cookie with the User ID number so the user logged in throughout the forum 'But only if not in admin modem and using all parts of part 1 of the reg form If (blnAdminMode = False) AND (intUpdatePartNumber = 0 OR intUpdatePartNumber = 1) Then 'Write the cookie with the name Forum containing the value UserID number Response.Cookies(strCookieName)("UID") = strUserCode 'If the user has selected to be remebered when they next login then set the expiry date for the cookie for 1 year If blnAutoLogin = True Then 'Set the expiry date for 1 year (365 days) 'If no expiry date is set the cookie is deleted from the users system 20 minutes after they leave the forum Response.Cookies(strCookieName).Expires = Now() + 365 End If End If '****************************************** '*** Send activate email *** '****************************************** 'Inititlaise the subject of the e-mail that may be sent in the next if/ifelse statements strSubject = "" & strTxtWelcome & " " & strTxtEmailToThe & " " & strMainForumName 'If the members account needs to be activated or reactivated then send the member a re-activate mail a redirect them to a page to tell them there account needs re-activating If (blnEmailActivation = True AND strMode = "new") OR blnAccountReactivate = True Then 'Send an e-mail to enable the users account to be activated 'Initailise the e-mail body variable with the body of the e-mail strEmailBody = strTxtHi & " " & decodeString(strUsername) strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtEmailThankYouForRegistering & " " & strMainForumName & "." strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtUsername & ": - " & decodeString(strUsername) strEmailBody = strEmailBody & vbCrLf & strTxtPassword & ": - " & strPassword strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtToActivateYourMembershipFor & " " & strMainForumName & " " & strTxtForumClickOnTheLinkBelow & ": -" strEmailBody = strEmailBody & vbCrLf & vbCrLf & strForumPath & "activate.asp?ID=" & Server.URLEncode(strUserCode) 'Send the e-mail using the Send Mail function created on the send_mail_function.inc file blnSentEmail = SendMail(strEmailBody, decodeString(strUsername), decodeString(strEmail), strMainForumName, decodeString(strForumEmailAddress), strSubject, strMailComponent, false) 'Reset server Object rsCommon.Close Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect the reactivate page If blnAccountReactivate = True Then Response.Redirect("register_confirm.asp?TP=REACT&FID=" & intForumID) 'Redirect to the activate page Else Response.Redirect("register_confirm.asp?TP=ACT&FID=" & intForumID) End If '****************************************** '*** Send welcome email *** '****************************************** 'Send the new user a welcome e-mail if e-mail notification is turned on and the user has given an e-mail address ElseIf blnEmail = True AND strEmail <> "" AND strMode = "new" Then 'Initailise the e-mail body variable with the body of the e-mail strEmailBody = strTxtHi & " " & decodeString(strUsername) strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtEmailThankYouForRegistering & " " & strMainForumName & "." strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtEmailYouCanNowUseTheForumAt & " " & strWebsiteName & " " & strTxtEmailForumAt & " " & strForumPath strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtUsername & ": - " & strUsername strEmailBody = strEmailBody & vbCrLf & strTxtPassword & ": - " & decodeString(strPassword) 'Send the e-mail using the Send Mail function created on the send_mail_function.inc file blnSentEmail = SendMail(strEmailBody, decodeString(strUsername), decodeString(strEmail), strMainForumName, decodeString(strForumEmailAddress), strSubject, strMailComponent, false) End If rsCommon.Close '****************************************** '*** Save the custom profile fields *** '****************************************** If intUpdatePartNumber = 0 OR intUpdatePartNumber = 3 Then Dim intFieldID Dim strFieldValue Dim rsFieldValue Set rsFieldValue = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT " & strDBTable & "ProfileFields.* FROM " & strDBTable & "ProfileFields;" rsCommon.Open strSQL, adoCon If NOT rsCommon.EOF Then DO UNTIL rsCommon.EOF intFieldID = Clng(rsCommon("Field_ID")) strFieldValue = Request.Form("CF" & intFieldID) strSQL = "SELECT " & strDBTable & "ProfileValues.* FROM " & strDBTable & "ProfileValues WHERE Field_ID = " & intFieldID & " AND Author_ID = " & intFieldID & ";" rsFieldValue.Open strSQL, adoCon, 3, 3 With rsFieldValue If .EOF Then .AddNew .Fields("Field_ID") = intFieldID .Fields("Author_ID") = lngUserProfileID .Fields("Value") = strFieldValue .Update End With rsFieldValue.Close rsCommon.MoveNext Loop End If rsCommon.Close Set rsFieldValue = Nothing End If '****************************************** '*** Clean up *** '****************************************** 'Reset server Object Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing '****************************************** '*** Redirect to message page *** '****************************************** 'Redirect the welcome new user page If strMode = "new" Then Response.Redirect("register_confirm.asp?TP=NEW&FID=" & intForumID) 'Redirect to the update profile page Else Response.Redirect("register_confirm.asp?TP=UPD&FID=" & intForumID) End If 'Else close rs Else rsCommon.Close End If End If '****************************************** '*** Set the page mode *** '****************************************** 'If this is a new registerant then reset the mode of the page to new If strMode = "reg" OR strMode = "new" Then 'set the mode to new strMode = "new" '********** Create Security Code ********** 'Initliase variable Session("lngSecurityCode") = "" 'Create a new session security code For lngLoopCounter = 1 to 6 'Randomise the system timer Randomize Timer 'Place the random number onto the end of teh security code session variable Session("lngSecurityCode") = Session("lngSecurityCode") & CStr(CInt(Rnd * 9)) Next 'Else this is an update Else strMode = "update" End If '****************************************** '*** Get the user details from db *** '****************************************** 'If this is a profile update get the users details to update If strMode = "update" Then '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 & "AuthorDetails @lngUserID = " & lngUserProfileID Else strSQL = "SELECT " & strDbTable & "Author.* " strSQL = strSQL & "FROM " & strDbTable & "Author " strSQL = strSQL & "WHERE " & strDbTable & "Author.Author_ID = " & lngUserProfileID End If 'Query the database rsCommon.Open strSQL, adoCon 'If there is no matching profile returned by the recordset then redirect the user to the main forum page If rsCommon.EOF Then 'Reset server Object rsCommon.Close Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing Response.Redirect("default.asp") End If 'Read in the new user's profile from the recordset strUsername = rsCommon("Username") strRealName = rsCommon("Real_name") strEmail = Trim(rsCommon("Author_email")) blnShowEmail = CBool(rsCommon("Show_email")) strHomepage = rsCommon("Homepage") If isNull(rsCommon("Location")) Then strLocation = "" Else strLocation = rsCommon("Location") blnSubscribeMailingList = CBool(rsCommon("Mailing_list")) strSignature = rsCommon("Signature") strAvatar = rsCommon("Avatar") strMemberTitle = rsCommon("Avatar_title") 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")) strICQNum = rsCommon("ICQ") strAIMAddress = rsCommon("AIM") strMSNAddress = rsCommon("MSN") strYahooAddress = rsCommon("Yahoo") strOccupation = rsCommon("Occupation") strInterests = rsCommon("Interests") dtmDateOfBirth = rsCommon("DOB") blnPMNotify = CBool(rsCommon("PM_notify")) 'If we are in admin mode then read on extra user details If blnAdminMode Then intUsersGroupID = CInt(rsCommon("Group_ID")) blnUserActive = CBool(rsCommon("Active")) lngPosts = CLng(rsCommon("No_of_posts")) End If 'Reset Server Objects rsCommon.Close 'If the user has enterd a date format then place in array If NOT strDateFormat = "" Then saryDateTimeData(0) = strDateFormat 'If admin mode is on and the user is only a moderator and the edited account is an admin account then the modertor can not edit the account If blnAdminMode AND blnModerator AND intUsersGroupID = 1 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) End If 'Split the date of biith into the various parts If isDate(dtmDateOfBirth) Then intDOBYear = Year(dtmDateOfBirth) intDOBMonth = Month(dtmDateOfBirth) intDOBDay = Day(dtmDateOfBirth) End If End If '****************************************** '*** De-code signature *** '****************************************** 'Covert the signature back to forum codes If strSignature <> "" Then strSignature = EditPostConvertion(strSignature) %> <% If strMode = "update" Then Response.Write("Edit Profile") Else Response.Write("Register New User") %> <% 'If this is an update and email notify is on show link to email subcriptions If strMode = "update" AND lngUserProfileID <> 2 Then Response.Write(vbCrlf & " " & _ vbCrLf & " " & _ vbCrLf & "
<% If strMode = "update" Then Response.Write(strTxtEditProfile) Else Response.Write(strTxtRegisterNewUser) %>
 <% = strMainForumName %><% = strNavSpacer %><% If strMode = "update" Then Response.Write(strTxtEditProfile) Else Response.Write(strTxtRegisterNewUser) %>") Response.Write("") 'email notify is on show link to email subcriptions If blnEmail Then Response.Write("") End If End If Response.Write("
") 'If an error has occured display what the error is, for those without JS If blnUsernameOK = False OR blnEmailOK = False OR blnEmailBlocked OR blnSecurityCodeOK = False OR blnConfirmPassOK = false Then Response.Write("
") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " " & _ vbCrLf & "" & _ vbCrLf & "
") 'If the username is already gone diaply an error message pop-up If blnUsernameOK = False Then Response.Write(Replace(strTxtUsrenameGone, "\n\n", "
") & "

") 'If the email address is used up and email activation is on, display an error message If blnEmailOK = False Then Response.Write(Replace(strTxtEmailAddressAlreadyUsed, "\n\n", "
") & "

") 'If the email address or domain is blocked If blnEmailBlocked = True Then Response.Write(strTxtEmailAddressBlocked & "

") 'If the security code is incorrect If blnSecurityCodeOK = False Then Response.Write(Replace(strTxtSecurityCodeDidNotMatch, "\n\n", "
") & "

") 'If the confirmed password is incorrect If blnConfirmPassOK = False Then Response.Write(Replace(strTxtConformOldPassNotMatching, "\n\n", "
") & "

") Response.Write("
") End If Call FormatTopTable("100%") %>
<% '************************************ '**** Registration Details **** '************************************ 'If part number = 0 (all) or part 1 (reg details) then show reg details If intUpdatePartNumber = 0 OR intUpdatePartNumber = 1 Then %> <% = strTxtRegistrationDetails %> *<% = strTxtRequiredFields %> <% = strTxtUsername %>*
<% = strTxtProfileUsernameLong %> <% 'If this is a new registration display a filed for the username If strMode = "new" OR blnAdmin Then %> <% Else Response.Write(strUsername) End If %> <% If strMode = "new" Then Response.Write(strTxtPassword & "*") Else Response.Write(strTxtNewPassword) %> <% If strMode = "new" Then Response.Write(strTxtRetypePassword & "*") Else Response.Write(strTxtRetypeNewPassword) %> <% 'If update confirm old pass if changing password If strMode ="update" AND blnAdminMode = false Then %> <% Response.Write(strTxtConfirmOldPass) %> <% End If %> <% = strTxtEmail %><% 'If email activation is on then tell the user for a real email address If blnEmailActivation = True Then If strMode = "new" Then Response.Write("*
" & strTxtEmailRequiredForActvation & "
") Else Response.Write("*
" & strTxtCahngeOfEmailReactivateAccount & "
") End If Else Response.Write("
" & strTxtProfileEmailLong & "
") End If %>   Mailing List
Subscribe or Un-Subscribe from this websites mailing list. > Subscribe > Un-Subscribe <% End If '********************************* '**** Security Code **** '********************************* 'If this is a new reg then ask for a seurity code If strMode = "new" Then %> <% = strTxtSecurityCodeConfirmation %> <% = strTxtUniqueSecurityCode %>
<% = strTxtCookiesMustBeEnabled %> <% = strTxtConfirmSecurityCode %>
<% = strTxtEnter6DigitCode %> <% End If '*********************************************** '**** Profile Information (not required) **** '*********************************************** If intUpdatePartNumber = 0 OR intUpdatePartNumber = 2 Then %> <% = strTxtProfileInformation %> <% = strTxtRealName %> <% = strTxtLocation %> <% 'If new reg don't show everything If ((blnLongRegForm AND strMode = "new") OR strMode <> "new") then %> <% = strTxtHomepage %> " /> <% = strTxtICQNumber %> <% = strTxtAIMAddress %> <% = strTxtMSNMessenger %> <% = strTxtYahooMessenger %> <% = strTxtOccupation %> <% = strTxtInterests %> <% = strTxtDateOfBirth %> <% = strTxtDay %> <% = strTxtCMonth %> <% = strTxtCYear %> <% End If '------------- Avatar --------------- 'If avatars are enabled then let the user select an avatar If blnAvatar = True Then %> <% = strTxtSelectAvatar %>
<% = strTxtSelectAvatarDetails & intAvatarHeight & " x " & intAvatarWidth & " " & strTxtPixels %>
<% Response.Write(vbCrLf & " "" Then Response.Write(strAvatar) Else Response.Write(strImagePath & "blank.gif") End If Response.Write(""" name=""avatar"" id=""avatar"" class=""postAvatar"">") Response.Write(vbCrLf & " "" Then Response.Write(strAvatar) Else Response.Write(strImagePath & "blank.gif") End If Response.Write(""" name=""avatarSize"" onLoad=""ProfileAvatarChange(this, '" & intMaxAvatarSize & "')"" id=""avatarSize"">") %>

0 Then Response.Write(strAvatar) Else Response.Write("http://") End If %>" onChange="oldAvatar.value=''" />
<% 'If avatar uploading is enabled and the user is registered then have a link to it If blnAvatarUploadEnabled AND intGroupID <> 2 AND blnActiveMember Then %> <% = strTxtAvatarUpload %> <% End If %> <% End If '----------------------------------------------- 'If new reg don't show everything If ((blnLongRegForm AND strMode = "new") OR strMode <> "new") then %> <% = strTxtSignature %>
<% = strTxtSignatureLong %> (max 200 characters)


<% = strTxtForumCodes %> <% = strTxtForumCodesInSignature %>
  <% = strTxtSignaturePreview %> <% = strTxtAlwaysAttachMySignature %> <% = strTxtYes %> />  <% = strTxtNo %> /> <% End If End If '********************************* '**** Forum Preferences **** '********************************* 'If part number = 0 (all) or part 3 (forum preferences) then show reg details If intUpdatePartNumber = 0 OR intUpdatePartNumber = 3 Then %> <% = strTxtForumPreferences %> <% 'If this is an update and only showing part 3 of the form with no email address entered don't show the 'show email' part of the form If (intUpdatePartNumber = 3 AND strEmail <> "") OR intUpdatePartNumber = 0 Then %> <% = strTxtShowHideEmail %>
<% = strTxtShowHideEmailLong %> <% = strTxtYes %> />  <% = strTxtNo %> /> <% End If 'If email notify is on give them a choice to receive mail or not If blnEmail = True Then %> <% = strTxtNotifyMeOfReplies %>
<% = strTxtSendsAnEmailWhenSomeoneRepliesToATopicYouHavePostedIn %> <% = strTxtYes %> />  <% = strTxtNo %> /> <% 'If private messageing is also on let them decide if they want to receive email notification when they get em If blnPrivateMessages = True Then %> <% = strTxtNotifyMeOfPrivateMessages %> <% = strTxtYes %> />  <% = strTxtNo %> /> <% End If End If 'If the IE WYSIWYG Editor is on let the user select if they want to use it or not If blnRTEEditor = True Then %> <% = strTxtEnableTheWindowsIEWYSIWYGPostEditor %> <% = strTxtYes %> />  <% = strTxtNo %> /> <% End If %> <% = strTxtProfileAutoLogin %> <% = strTxtYes %> />  <% = strTxtNo %> /> <% = strTxtTimezone %>
<% = strTxtPresentServerTimeIs %><% 'Get the current server time dtmServerTime = Now() 'Make sure that the time and date format function isn't effected by the server time off set If strTimeOffSet = "-" Then dtmServerTime = DateAdd("h", + intTimeOffSet, dtmServerTime) ElseIf strTimeOffSet = "+" Then dtmServerTime = DateAdd("h", - intTimeOffSet, dtmServerTime) End If 'Display the current server time Response.Write(DateFormat(dtmServerTime, saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(dtmServerTime, saryDateTimeData)) %> <% = strTxtHours %> <% = strTxtDateFormat %> <% End If '********************************** '**** Extra Field Values **** '********************************** 'If part number = 0 (all) or part 3 (forum preferences) then show reg details If intUpdatePartNumber = 0 OR intUpdatePartNumber = 3 AND blnUseCustomFields Then Dim rsCFFieldValue Dim intLoop Dim saryTempCustomFieldPermissions Dim blnShowCustomFieldTitle Dim blnShowCustomFields blnShowCustomFieldTitle = True Set rsCFFieldValue = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT " & strDBTable & "ProfileFields.* FROM " & strDBTable & "ProfileFields;" rsCommon.Open strSQL, adoCon If NOT rsCommon.EOF Then DO UNTIL rsCommon.EOF Dim strCFFieldValue strCFFieldValue = "" blnShowCustomFields = False saryTempCustomFieldPermissions = rsCommon("Field_permissions") If saryTempCustomFieldPermissions = "0," Then blnShowCustomFields = True Else saryTempCustomFieldPermissions = Split(saryTempCustomFieldPermissions, ",") For intLoop = 0 TO UBound(saryTempCustomFieldPermissions) - 1 If intGroupID = saryTempCustomFieldPermissions(intLoop) Then blnShowCustomFields = True Next End If If blnShowCustomFieldTitle AND blnShowCustomFields Then Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " Extra Options") Response.Write(vbCrLf & " ") End If If blnShowCustomFields Then If blnShowCustomFieldTitle Then blnShowCustomFieldTitle = False strSQL = "SELECT " & strDBTable & "ProfileValues.* FROM " & strDBTable & "ProfileValues WHERE Field_ID = " & rsCommon("Field_ID") & " AND Author_ID = " & lngUserProfileID & ";" rsCFFieldValue.Open strSQL, adoCon IF rsCFFieldValue.EOF Then strCFFieldValue = "" Response.Write(vbCrLf & "") Else strCFFieldValue = rsCFFieldValue("Value") Response.Write(vbCrLf & "") End If rsCFFieldValue.Close Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " " & rsCommon("Field_name") & "
" & rsCommon("Field_description") & "") Response.Write(vbCrLf & " ") Select Case rsCommon("Field_type") Case "text" Response.Write(vbCrLf & "") Case "checkbox" Response.Write(vbCrLf & "") Case "textarea" Response.Write(vbCrLf & "") End Select Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") End If rsCommon.MoveNext Loop End If rsCommon.Close Set rsCFFieldValue = Nothing End If '********************************************* '**** Admin and Moderator Functions **** '********************************************* 'If the admin mode is enabled then place some extra options in the edit profile (unless this is the Guest or Admin accounts) If blnAdminMode AND (blnAdmin Or blnModerator) Then %> <% = strTxtAdminModeratorFunctions %> <% 'Don't allow changing group if admin or guest account If lngUserProfileID > 2 Then %> <% = strTxtUserIsActive %> <% = strTxtYes %>>  <% = strTxtNo %> /> <% 'Only allow admin to change the member group If blnAdmin Then 'Get the forum groups from the database so admin can change the members group 'Initlise SQL query strSQL = "SELECT " & strDbTable & "Group.Group_ID, " & strDbTable & "Group.Name, " & strDbTable & "Group.Special_rank, " & strDbTable & "Group.Minimum_posts FROM " & strDbTable & "Group;" 'Query the database rsCommon.Open strSQL, adoCon 'If there are groups then disply them If NOT rsCommon.Eof Then %> <% = strTxtGroup %> <% End If End If End If %> <% = strTxtMemberTitle %> <% = strTxtNumberOfPosts %> <% 'Don't allow deleting account if admin or guest account If lngUserProfileID > 2 AND blnAdmin Then %> <% = strTxtDeleteThisUser %> <% = strTxtCheckThisBoxToDleteMember %> <% End If End If %> <% 'If this is admin mode then set the admin stuff up If blnAdminMode AND (blnAdmin Or blnModerator) Then %> <% End If %> " onClick="return CheckForm();" /> <% Call FormatBottomTable("100%") %>
<% '***** 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-2004 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 & "" %>
<% ON ERROR RESUME NEXT If isObject(rsCommon) Then rsCommon.Close ON ERROR GOTO 0 'If the username is already gone display an error message pop-up If blnUsernameOK = False Then Response.Write("") End If 'If the email address is used up and email activation is on, display an error message If blnEmailOK = False Then Response.Write("") End If 'If the email address or domain is blocked If blnEmailBlocked Then Response.Write("") End If 'If the security code did not match If blnSecurityCodeOK = False Then Response.Write("") End If 'If the confirmed password is incorrect If blnConfirmPassOK = False Then Response.Write("") End If %> <% 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing %>