admin_register.asp

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

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="admin_common.asp" -->
<!--#include file="functions/functions_format_post.asp" -->
<!--#include file="includes/emoticons_inc.asp" -->
<!--#include file="functions/functions_date_time_format.asp" -->
<!--#include file="functions/functions_format_post.asp" -->
<!--#include file="functions/functions_edit_post.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

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

                '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