% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Forums(TM) '** http://www.webwizforums.com '** '** Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved. '** '** THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'. '** '** IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE '** THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE '** AND DERIVATIVE WORKS IMMEDIATELY. '** '** If you have not received a copy of the license with this work then a copy of the latest '** license contract can be found at:- '** '** http://www.webwizguide.com/license '** '** For more information about this software and for licensing information please contact '** 'Web Wiz' at the address and website below:- '** '** Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England '** http://www.webwizguide.com '** '** Removal or modification of this copyright notice will violate the license contract. '** '**************************************************************************************** '*************************** SOFTWARE AND CODE MODIFICATIONS **************************** '** '** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE '** AGREEMENT AND IS STRICTLY PROHIBITED '** '** If you wish to modify any part of this software a license must be purchased '** '**************************************************************************************** '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 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 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 Dim strSkypeName 'Holds the users Skype Name Dim strFormID 'Form ID Dim blnSuspended 'Holds if user is suspened Dim strAdminNotes 'Holds admin/modertor info/notes about the user Dim blnNewsletter 'Set to true if newsletters are selected Dim strGender 'Holds the users gender '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 blnNewsletter = False '****************************************** '*** 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 Call closeDatabase() 'Redirect Response.Redirect("registration_rules.asp?FID=" & intForumID & strQsSID3) 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 OR blnBanned Then 'clean up before redirecting Call closeDatabase() 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?M=ACT" & strQsSID3) 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 Call closeDatabase() 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp" & strQsSID1) 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 AND blnModeratorProfileEdit Then 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT " & strDbTable & "Permissions.Moderate " & _ "FROM " & strDbTable & "Permissions" & strDBNoLock & " " & _ "WHERE (" & strDbTable & "Permissions.Group_ID = " & intGroupID & " OR " & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & ") AND " & strDbTable & "Permissions.Moderate=" & strDBTrue & ";" '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 Call closeDatabase() 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?FID=" & intForumID & strQsSID3) End If 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 checkFormID(Request.Form("formID")) Call saveSessionItem("formID", "") '****************************************** '*** Check security code *** '****************************************** If strMode = "new" AND blnCAPTCHAsecurityImages Then 'Set the security code OK variable to false If LCase(getSessionItem("SCS")) <> LCase(Request.Form("securityCode")) OR getSessionItem("SCS") = "" Then blnSecurityCodeOK = False End If 'Distroy session variable Call saveSessionItem("SCS", "") '****************************************** '*** Read in member details from form *** '****************************************** 'Read in the users details from the form If strMode = "new" Then strUsername = Trim(Mid(Request.Form("name"), 1, 20)) '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("password1"), 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 strRealName = Trim(Mid(Request.Form("realName"), 1, 27)) strGender = Trim(Mid(Request.Form("gender"), 1, 10)) strLocation = Trim(Mid(Request.Form("location"), 1, 27)) strHomepage = Trim(Mid(Request.Form("homepage"), 1, 48)) strSignature = Mid(Request.Form("signature"), 1, 210) 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)) strSkypeName = Trim(Mid(Request.Form("Skype"), 1, 30)) 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 = internationalDateTime(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 If blnWebWizNewsPad Then blnNewsletter = CBool(Request.Form("newsletter")) 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 AND blnDemoMode = False 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)) blnSuspended = CBool(Request.Form("banned")) strAdminNotes = Trim(Mid(removeAllTags(Request.Form("notes")), 1, 255)) 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) strGender = removeAllTags(strGender) strGender = formatInput(strGender) strLocation = removeAllTags(strLocation) strLocation = formatInput(strLocation) 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 = HTMLsafe(strSignature) 'Trim signature down to a 255 max characters to prevent database errors strSignature = Mid(strSignature, 1, 255) '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) strEmail = Replace(strEmail, """", "", 1, -1, 1) '****************************************** '*** 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" & strDBNoLock & ";" '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" AND Instr(1, strUsername, strSmutWord, 1) Then blnUsernameOK = False 'If username contains a smut word then make the user choose another username strRealName = Replace(strRealName, strSmutWord, strSmutWordReplace, 1, -1, 1) strGender = Replace(strGender, 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 the avatar is OK *** '****************************************** 'Remove malicious code form the avatar link or remove it all togtaher if not a web graphic If strAvatar <> "" Then 'Call the filter for the image strAvatar = checkImages(strAvatar) strAvatar = formatInput(strAvatar) End If '****************************************** '*** Check the username is OK *** '****************************************** 'If this is a new reg clean up the username If strMode = "new" Then 'Check there is a username If Len(strUsername) < 2 Then blnUsernameOK = False 'Make sure the user has not entered disallowed usernames If InStr(1, strUsername, "admin", vbTextCompare) Then blnUsernameOK = False 'Clean up user input strUsername = formatSQLInput(strUsername) End If '****************************************** '*** 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" 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" & strDBNoLock & " " & _ "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 strSQL = "SELECT " & strDbTable & "Group.Group_ID " & _ "FROM " & strDbTable & "Group" & strDBNoLock & " " & _ "WHERE " & strDbTable & "Group.Starting_group = " & strDBTrue & ";" '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" & strDBNoLock & " " & _ "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) '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 '2nd check Use the same filters as that on the email address being checked 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 = 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 = True Then 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT " & strDbTable & "Author.Author_email " & _ "FROM " & strDbTable & "Author" & strDBNoLock & " " & _ "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 strSQL = "SELECT " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Group_ID, " & strDbTable & "Author.Username, " & strDbTable & "Author.Real_name, " & strDbTable & "Author.Gender, " & strDbTable & "Author.User_code, " & strDbTable & "Author.Password, " & strDbTable & "Author.Salt, " & strDbTable & "Author.Author_email, " & strDbTable & "Author.Homepage, " & strDbTable & "Author.Location, " & strDbTable & "Author.MSN, " & strDbTable & "Author.Yahoo, " & strDbTable & "Author.ICQ, " & strDbTable & "Author.AIM, " & strDbTable & "Author.Occupation, " & strDbTable & "Author.Interests, " & strDbTable & "Author.DOB, " & strDbTable & "Author.Signature, " & strDbTable & "Author.No_of_posts, " & strDbTable & "Author.No_of_PM, " & strDbTable & "Author.Join_date, " & strDbTable & "Author.Avatar, " & strDbTable & "Author.Avatar_title, " & strDbTable & "Author.Last_visit, " & strDbTable & "Author.Time_offset, " & strDbTable & "Author.Time_offset_hours, " & strDbTable & "Author.Date_format, " & strDbTable & "Author.Show_email, " & strDbTable & "Author.Attach_signature, " & strDbTable & "Author.Active, " & strDbTable & "Author.Rich_editor, " & strDbTable & "Author.Reply_notify, " & strDbTable & "Author.PM_notify, " & strDbTable & "Author.Skype, " & strDbTable & "Author.Login_attempt, " & strDbTable & "Author.Banned, " & strDbTable & "Author.Info, " & strDbTable & "Author.Newsletter " &_ "FROM " & strDbTable & "Author" & strRowLock & " " & _ "WHERE " & strDbTable & "Author.Author_ID = " & lngUserProfileID & ";" '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 suspending the user account then update the user code If (blnUserActive = False OR blnSuspended) AND lngUserProfileID > 2 Then strUserCode = userCode(strUsername) 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 Call closeDatabase() 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?FID=" & intForumID & strQsSID3) 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 'If encrypted passwords If blnEncryptedPasswords 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 strEncryptedPassword = HashEncode(strEncryptedPassword) 'Else if not using encrypted passwords Else strEncryptedPassword = strPassword End If 'Set the changed password boolean to true If blnDemoMode = False Then 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 rsCommon.AddNew 'Insert the user's details into the rs With rsCommon If strMode = "new" Then .Fields("Username") = strUsername .Fields("Group_ID") = intForumStartingGroup .Fields("Join_date") = internationalDateTime(Now()) .Fields("Last_visit") = internationalDateTime(Now()) .Fields("Banned") = False .Fields("Info") = "" 'This is to prevent errors in mySQL .Fields("No_of_posts") = 0 .Fields("No_of_PM") = 0 .Fields("Login_attempt") = 0 End If '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 If blnWindowsAuthentication = False Then .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("Gender") = strGender .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("Homepage") = strHomepage .Fields("ICQ") = strICQNum .Fields("AIM") = strAIMAddress .Fields("MSN") = strMSNAddress .Fields("Yahoo") = strYahooAddress .Fields("Skype") = strSkypeName .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 If blnWebWizNewsPad Then .Fields("Newsletter") = blnNewsletter 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 OR blnMemberApprove) AND strMode = "new") OR blnAccountReactivate) AND blnModerator = False Then .Fields("Active") = False Else .Fields("Active") = True End If 'If the admin mode is enabled then the admin can also update some other member parts If blnAdminMode AND (blnAdmin Or blnModerator) AND strMode = "update" AND blnDemoMode = False Then If lngUserProfileID > 2 Then .Fields("Active") = blnUserActive .Fields("Avatar_title") = strMemberTitle .Fields("Banned") = blnSuspended .Fields("Info") = strAdminNotes 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 'Set error trapping On Error Resume Next 'Update the database with the new user's details (needed for MS Access which can be slow updating) .Update 'If an error has occurred write an error to the page If Err.Number <> 0 AND strMode = "new" Then Call errorMsg("An error has occurred while writing to the database.", "register_USR", "register.asp") ElseIf Err.Number <> 0 Then Call errorMsg("An error has occurred while writing to the database.", "update_USR", "register.asp") End If 'Disable error trapping On Error goto 0 'Re-run the query (required for Access to give it time to update on slower servers) .Requery 'Close rs .Close 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) AND blnWindowsAuthentication = False Then 'Write the cookie with the name Forum containing the value UserID number Call saveSessionItem("UID", strUserCode) 'Auto Login cookie If blnAutoLogin Then Call setCookie("sLID", "UID", strUserCode, True) 'Temp Cookie Else Call setCookie("sLID", "UID", strUserCode, False) 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 OR blnMemberApprove) AND strMode = "new") OR blnAccountReactivate Then 'If new registration we need to get the new users ID from the database If strMode = "new" Then 'SQL to get the new Author_ID from the database strSQL = "SELECT " & strDBTop1 & " " & strDbTable & "Author.Author_ID " & _ "FROM " & strDbTable & "Author" & strDBNoLock & " " & _ "ORDER BY " & strDbTable & "Author.Author_ID DESC" & strDBLimit1 & ";" 'Query database rsCommon.Open strSQL, adoCon 'Read back in the user ID for the activation email lngUserProfileID = CLng(rsCommon("Author_ID")) 'Close rs rsCommon.Close End If 'If the admin needs to apporove the member send the activation email to the forum admin If blnMemberApprove Then 'Create admin activation email strEmailBody = strTxtHi & ", " & _ vbCrLf & vbCrLf & strTxtEmailNewUserRegistered & " " & strMainForumName & "." & _ vbCrLf & vbCrLf & "----------------------------" & _ vbCrLf & strTxtUsername & ": - " & decodeString(strUsername) & _ vbCrlf & strTxtEmailAddress & ": - " & strEmail & _ vbCrLf & strTxtIPLogged & ": - " & getIP() & _ vbCrLf & "----------------------------" & _ vbCrLf & vbCrLf & strTxtToActivateTheNewMembershipFor & " " & decodeString(strUsername) & " " & strTxtForumClickOnTheLinkBelow & ": -" & _ vbCrLf & vbCrLf & strForumPath & "admin_activate.asp?USD=" & lngUserProfileID 'Send the e-mail using the Send Mail function created on the send_mail_function.inc file blnSentEmail = SendMail(strEmailBody, strTxtForumAdmin, decodeString(strForumEmailAddress), strMainForumName, decodeString(strForumEmailAddress), strTxtNewMemberActivation, strMailComponent, false) 'If user has an email address send em a welcome email If blnEmail AND strEmail <> "" Then 'Initailise the e-mail body variable with the body of the e-mail strEmailBody = strTxtHi & " " & decodeString(strUsername) & _ vbCrLf & vbCrLf & strTxtEmailThankYouForRegistering & " " & strMainForumName & "." & _ vbCrLf & vbCrLf & strTxtEmailYouCanNowUseOnceYourAccountIsActivatedTheForumAt & " " & strWebsiteName & " " & strTxtEmailForumAt & " " & strForumPath & _ vbCrLf & vbCrLf & "----------------------------" & _ vbCrLf & strTxtUsername & ": - " & strUsername & _ vbCrLf & strTxtPassword & ": - " & decodeString(strPassword) & _ vbCrLf & "----------------------------" If blnEncryptedPasswords Then strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtPleaseDontForgetYourPassword '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 'Send an email to enable the users account to be re-activated ElseIf blnAccountReactivate Then 'Email subject strSubject = strMainForumName & " " & strTxtActivationEmail 'Create re-activate email body strEmailBody = strTxtHi & " " & decodeString(strLoggedInUsername) & _ vbCrLf & vbCrLf & strTxtYourEmailHasChanged & ", " & strMainForumName & ", " & strTxtPleaseUseLinkToReactivate & "." & _ vbCrLf & vbCrLf & strTxtToActivateYourMembershipFor & " " & strMainForumName & " " & strTxtForumClickOnTheLinkBelow & ": -" & _ vbCrLf & vbCrLf & strForumPath & "activate.asp?ID=" & Server.URLEncode(strUserCode) & "&USD=" & lngUserProfileID '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) 'Else send that this is a new mail account so send activation email Else 'Create email activate email body strEmailBody = strTxtHi & " " & decodeString(strUsername) & _ vbCrLf & vbCrLf & strTxtEmailThankYouForRegistering & " " & strMainForumName & "." & _ vbCrLf & vbCrLf & "----------------------------" & _ vbCrLf & strTxtUsername & ": - " & decodeString(strUsername) & _ vbCrLf & strTxtPassword & ": - " & strPassword & _ vbCrLf & "----------------------------" & _ vbCrLf & vbCrLf & strTxtToActivateYourMembershipFor & " " & strMainForumName & " " & strTxtForumClickOnTheLinkBelow & ": -" & _ vbCrLf & vbCrLf & strForumPath & "activate.asp?ID=" & Server.URLEncode(strUserCode) & "&USD=" & lngUserProfileID If blnEncryptedPasswords Then strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtPleaseDontForgetYourPassword '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 'Reset server Object Call closeDatabase() 'Redirect if admin activate If blnMemberApprove Then Response.Redirect("register_confirm.asp?TP=MACT&FID=" & intForumID & strQsSID3) 'Redirect the reactivate page ElseIf blnAccountReactivate = True Then Response.Redirect("register_confirm.asp?TP=REACT&FID=" & intForumID & strQsSID3) 'Redirect to the activate page Else Response.Redirect("register_confirm.asp?TP=ACT&FID=" & intForumID & strQsSID3) 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 AND strEmail <> "" AND strMode = "new" Then 'Initailise the e-mail body variable with the body of the e-mail strEmailBody = strTxtHi & " " & decodeString(strUsername) & _ vbCrLf & vbCrLf & strTxtEmailThankYouForRegistering & " " & strMainForumName & "." & _ vbCrLf & vbCrLf & strTxtEmailYouCanNowUseTheForumAt & " " & strWebsiteName & " " & strTxtEmailForumAt & " " & strForumPath & _ vbCrLf & vbCrLf & "----------------------------" & _ vbCrLf & strTxtUsername & ": - " & strUsername & _ vbCrLf & strTxtPassword & ": - " & decodeString(strPassword) & _ vbCrLf & "----------------------------" If blnEncryptedPasswords Then strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtPleaseDontForgetYourPassword '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 '****************************************** '*** Clean up *** '****************************************** 'Reset server Object Call closeDatabase() '****************************************** '*** Redirect to message page *** '****************************************** 'Redirect the welcome new user page If strMode = "new" Then Response.Redirect("register_confirm.asp?TP=NEW&FID=" & intForumID & strQsSID3) 'Redirect to the update profile page Else Response.Redirect("register_confirm.asp?TP=UPD&FID=" & intForumID & strQsSID3) 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" '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 strSQL = "SELECT " & strDbTable & "Author.* " & _ "FROM " & strDbTable & "Author" & strDBNoLock & " " & _ "WHERE " & strDbTable & "Author.Author_ID = " & lngUserProfileID '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 Call closeDatabase() Response.Redirect("default.asp" & strQsSID1) End If 'Read in the new user's profile from the recordset strUsername = rsCommon("Username") strRealName = rsCommon("Real_name") strGender = rsCommon("Gender") If NOT isNull(rsCommon("Author_email")) Then strEmail = formatInput(rsCommon("Author_email")) If blnWebWizNewsPad Then blnNewsletter = CBool(rsCommon("Newsletter")) blnShowEmail = CBool(rsCommon("Show_email")) If NOT isNull(rsCommon("Homepage")) Then strHomepage = formatInput(rsCommon("Homepage")) If NOT isNull(rsCommon("Location")) Then strLocation = rsCommon("Location") 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")) If NOT isNull(rsCommon("ICQ")) Then strICQNum = formatInput(rsCommon("ICQ")) If NOT isNull(rsCommon("AIM")) Then strAIMAddress = formatInput(rsCommon("AIM")) If NOT isNull(rsCommon("MSN")) Then strMSNAddress = formatInput(rsCommon("MSN")) If NOT isNull(rsCommon("Yahoo")) Then strYahooAddress = formatInput(rsCommon("Yahoo")) If NOT isNull(rsCommon("Skype")) Then strSkypeName = formatInput(rsCommon("Skype")) 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")) blnSuspended = CBool(rsCommon("Banned")) strAdminNotes = rsCommon("Info") 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,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 Call closeDatabase() 'redirect to insufficient permissions page Response.Redirect("insufficient_permission.asp?FID=" & intForumID & strQsSID3) 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) 'Create a form ID strFormID = LCase(hexValue(10)) 'Place formID into app session Call saveSessionItem("formID", strFormID) 'Set bread crumb trail If strMode = "update" Then strBreadCrumbTrail = strBreadCrumbTrail & strNavSpacer & strTxtEditProfile Else strBreadCrumbTrail = strBreadCrumbTrail & strNavSpacer & strTxtRegisterNewUser End If %>
<% If strMode = "update" Then Response.Write(strTxtEditProfile) Else Response.Write(strTxtRegisterNewUser) %> |
|
" title="<% = strTxtControlPanel %>" class="tabButton"> |
<% = strTxtError %> |
| <%
'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", " ") & " ") %> |