% @ 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 'Dimension variables 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 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 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 strUsername 'Holds the users username Dim strPassword 'Holds the usres password Dim strUserCode 'Holds the users ID code Dim strSalt 'Holds the salt value for the new member Dim blnSuspended Dim strAdminNotes Dim blnNewsletter 'Set to true if newsletters are selected Dim strGender 'Holds the users gender 'Initlise variables blnUsernameOK = True lngPosts = 0 blnUserActive = True blnNewsletter = False 'See if we are editing a user lngUserProfileID = CLng(Request("PF")) 'Don't allow editing of guest account If lngUserProfileID < 3 Then lngUserProfileID = 0 'If we have a ID number then put in adit mode If lngUserProfileID <> 0 Then strMode = "edit" Else strMode = "new" End If 'If the Profile has already been edited then update the Profile If Request.Form("postBack") AND blnDemoMode = False Then '****************************************** '*** Read in member details from form *** '****************************************** 'Read in the users details from the form strUsername = Trim(Mid(Request.Form("name1"), 1, 20)) strPassword = LCase(Trim(Mid(Request.Form("password1"), 1, 15))) strEmail = Trim(Mid(Request.Form("email"), 1, 60)) strRealName = Trim(Mid(Request.Form("realName"), 1, 27)) strGender = Trim(Mid(Request.Form("gender"), 1, 10)) 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)) 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")) blnUserActive = CBool(Request.Form("active")) intUsersGroupID = CInt(Request.Form("group")) 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)) If blnWebWizNewsPad Then blnNewsletter = CBool(Request.Form("newsletter")) '****************************************** '*** Read in the avatar *** '****************************************** 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 = "" '****************************************** '*** Clean up member details *** '****************************************** 'Clean up user input strRealName = removeAllTags(strRealName) strRealName = formatInput(strRealName) strGender = removeAllTags(strGender) strGender = formatInput(strGender) '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) 'If the user has not entered a hoempage then make sure the homepage variable is blank If strHomepage = "http://" Then strHomepage = "" 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 *** '****************************************** '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 = formatInput(strAvatar) End If '****************************************** '*** Check the username is OK *** '****************************************** 'Check there is a username If strUsername = "" Then blnUsernameOK = False 'Clean up user input strUsername = formatSQLInput(strUsername) '****************************************** '*** 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 & "' AND " & strDbTable & "Author.Author_ID <> " & lngUserProfileID & ";" 'Set the cursor type property of the record set to Forward Only rsCommon.CursorType = 0 '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 'If there is a record returned from the database then the username is already used If NOT rsCommon.EOF Then blnUsernameOK = False End If 'Remove SQL safe single quote double up set in the format SQL function strUsername = Replace(strUsername, "''", "'", 1, -1, 1) 'Close rs rsCommon.Close End If '****************************************** '*** Create a usercode *** '****************************************** 'Calculate a code for the user strUserCode = userCode(strUsername) '****************************************** '*** Encrypt password *** '****************************************** 'Encrypt password If strPassword <> "" Then 'Encrypt password If blnEncryptedPasswords Then 'Genrate a slat value strSalt = getSalt(Len(strPassword)) 'Concatenate salt value to the password strEncryptedPassword = strPassword & strSalt 'Encrypt the password strEncryptedPassword = HashEncode(strEncryptedPassword) 'Else the password is not set to be encrypted so place the un-encrypted password into the strEncryptedPassword variable Else strEncryptedPassword = strPassword End If End If '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 Forward Only rsCommon.CursorType = 0 '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 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 blnUsernameOK Then 'Insert the user's details into the rs With rsCommon 'If not an edit then addnew If strMode <> "edit" Then .AddNew 'Don't update username is member API is enabled If blnMemberAPI = False Then .Fields("Username") = strUsername .Fields("Group_ID") = intUsersGroupID 'If new undate the fields below If strMode = "new" Then .Fields("Join_date") = internationalDateTime(Now()) .Fields("Last_visit") = internationalDateTime(Now()) End If 'If the password has changed update it If strPassword <> "" Then .Fields("Password") = strEncryptedPassword .Fields("Salt") = strSalt End If 'Don't update user code filed is windows authentication is enabeld If blnWindowsAuthentication = False Then .Fields("User_code") = strUserCode .Fields("Author_email") = strEmail .Fields("Real_name") = strRealName .Fields("Gender") = strGender .Fields("Avatar") = strAvatar .Fields("Homepage") = strHomepage .Fields("Signature") = strSignature .Fields("Attach_signature") = blnAttachSignature .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 'Admin bits .Fields("Active") = blnUserActive .Fields("Avatar_title") = strMemberTitle .Fields("No_of_posts") = lngPosts .Fields("Banned") = blnSuspended .Fields("Info") = strAdminNotes '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 '****************************************** '*** Clean up *** '****************************************** 'Reset server Object rsCommon.Close Call closeDatabase() '****************************************** '*** Redirect to message page *** '****************************************** 'Redirect the welcome new user page Response.Redirect("admin_added_member.asp?M=" & strMode & strQsSID3) End If rsCommon.Close End If '****************************************** '*** Get the user details from db *** '****************************************** 'If this is a profile update get the users details to update If strMode = "edit" 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")) 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")) blnPMNotify = CBool(rsCommon("PM_notify")) intUsersGroupID = CInt(rsCommon("Group_ID")) blnUserActive = CBool(rsCommon("Active")) lngPosts = CLng(rsCommon("No_of_posts")) blnSuspended = CBool(rsCommon("Banned")) strAdminNotes = rsCommon("Info") 'Reset Server Objects rsCommon.Close End If 'Covert the signature back to forum codes If strSignature <> "" Then strSignature = EditPostConvertion(strSignature) %>