register.asp

简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全

	'***  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