register.asp

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

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="functions/functions_send_mail.asp" -->
<!--#include file="functions/functions_edit_post.asp" -->
<!--#include file="functions/functions_format_post.asp" -->
<!--#include file="functions/functions_date_time_format.asp" -->
<!--#include file="includes/emoticons_inc.asp" -->
<!--#include file="language_files/admin_language_file_inc.asp" -->
<!--#include file="functions/functions_hash1way.asp" -->
<%
'****************************************************************************************
'**  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", "")


	'******************************************