<%
function EncryptString(string)
Dim x, i, tmp
For i = 1 To Len( string )
x = Mid( string, i, 1 )
tmp = tmp & Chr( Asc( x ) + 1 )
Next
tmp = StrReverse( tmp )
EncryptString = tmp
end function
function DecryptString(encryptedstring)
Dim x, i, tmp
encryptedstring = StrReverse( encryptedstring )
For i = 1 To Len( encryptedstring )
x = Mid( encryptedstring, i, 1 )
tmp = tmp & Chr( Asc( x ) - 1 )
Next
DecryptString = tmp
end function
sub insert_or_update_user
':: called when a user attempts to register
set rs=cn.Execute("SELECT user_id, user_name FROM Users WHERE email=" & to_sql(email,"text"))
if rs.EOF then
'' new user
db_insert_register
else
'' email already exists
user_id=rs("user_id")
if isNull(rs("user_name")) or rs("user_name")="" then
'' allow update of existing user account
db_update_register
else
'' do not allow update if user_name is not empty
b_error = true
user_id = ""
end if
end if
if not b_error then
set rs = cn.Execute("SELECT * FROM Newsletters WHERE new_user_default = 1")
if not rs.EOF then
sender_name=NULL
sender_address=NULL
retv = SendAppEmail(rs("newsletter_id"),to_sql(email,"text"),NULL,to_sql(email,"text"))
end if
response.redirect "login.asp?action=logout&msg=Thanks.+please+login"
else
error_list.add "reg", "You missed a required field OR the username or email is already registered."
error_list.add "reg1", "Click here to find a lost password."
end if
rs.Close
end sub
%>
<%
' ::::::::: BEGIN COPYRIGHT and LICENSE :::::::::::::::::::::::::::::::::::::::::::::
' Removal of this section is a violation of license and terms of use.
' Source code Copyright 2000-2002 Iatek (http://www.iatek.com). All Rights Reserved.
' Generated by ASPapp.com. More information can be obtained at http://www.aspapp.com
' This script can be installed and run on 1 Web site. Copying or redistribution
' is prohibited unless additional site licenses for this script are purchased.
' ::::::::: END COPYRIGHT and LICENSE ::::::::::::::::::::::::::::::::::::::::::::::
':::: page structure
'-- variables are declared (dim)
'-- the "request_" and "validate_" subroutines for form output
'-- the "db_" subroutines for database SQL statements
'-- key database fields are requested
'-- the action variable is requested and handled
'-- main section (this ignores value of action variable)
'-- HTML begins: The 'i_header.asp' include file is displayed
'-- forms and content are displayed
'-- HTML ends: The 'i_footer.asp' include file is displayed
'-- close database resources
':::: recommended DATABASE SCHEMA for this page
' Users:
' user_id: int identity|int: 4
' user_type_id: smallint: 2
' group_id: int identity|int: 4
' user_name: text|varchar: 50
' f_name: text|varchar: 50
' l_name: text|varchar: 70
' email: text|varchar: 60
' password: text|varchar: 50
' addr1: text|varchar: 100
' addr2: text|varchar: 50
' city: text|varchar: 50
' state: text|varchar: 50
' postalcode: text|varchar: 50
' country: text|varchar: 50
' phone: text|varchar: 40
' fax: text|varchar: 40
' notes: longtext|memo: 536870910
' selfemp: byte: 1
' dtinserted: datetime: 8
' dtmodified: datetime: 8
' dtlast: datetime: 8
' accesslevel: int identity|int: 4
' mailing_list: byte: 1
' util_val: int identity|int: 4
' util_flag: byte: 1
' account_no: text|varchar: 40
' homepage_url: text|varchar: 70
' signature: text|varchar: 255
' image: text|varchar: 30
' refered_by: text|varchar: 30
' confirmed: byte: 1
' last_ip: text|varchar: 30
dim email_address
dim confirm_email_sql
dim content_field
dim reg_code
dim dtInserted
dim accesslevel
dim user_id
dim user_name
dim f_name
dim l_name
dim email
dim password
dim addr1
dim addr2
dim city
dim state
dim postalcode
dim country
dim phone
dim mailing_list
dim notes
dim register_sql
sub request_confirm_email
''' request form inputs from this form
email_address = request("email_address")
end sub
sub request_register
''' request form inputs from this form
reg_code = request("reg_code")
dtInserted = request("dtInserted")
accesslevel = request("accesslevel")
user_id = request("user_id")
user_name = request("user_name")
f_name = request("f_name")
l_name = request("l_name")
email = request("email")
password = request("password")
addr1 = request("addr1")
addr2 = request("addr2")
city = request("city")
state = request("state")
postalcode = request("postalcode")
country = request("country")
phone = request("phone")
mailing_list = request("mailing_list")
notes = request("notes")
end sub
sub validate_confirm_email
''' request and validate data entered from this form
email_address = trim(request("email_address"))
end sub
sub validate_register
''' request and validate data entered from this form
reg_code = trim(request("reg_code"))
dtInserted = trim(request("dtInserted"))
if dtInserted <> "" AND (not isdate(dtInserted)) then
error_list.add "661656date"," must be a valid date (MM/DD/YY)."
b_error = true
end if
accesslevel = trim(request("accesslevel"))
user_id = trim(request("user_id"))
user_name = trim(request("user_name"))
if user_name = "" then
error_list.add "661643","Desired username must be specified."
b_error = true
end if
f_name = trim(request("f_name"))
l_name = trim(request("l_name"))
email = trim(request("email"))
if email = "" then
error_list.add "661646","Email must be specified."
b_error = true
end if
password = trim(request("password"))
if password = "" then
error_list.add "661647","Password must be specified."
b_error = true
end if
addr1 = trim(request("addr1"))
addr2 = trim(request("addr2"))
city = trim(request("city"))
state = trim(request("state"))
postalcode = trim(request("postalcode"))
country = trim(request("country"))
phone = trim(request("phone"))
mailing_list = trim(request("mailing_list"))
notes = trim(request("notes"))
end sub
sub get_defaults_register
''' set default values for this form
accesslevel = 1
country = "United States"
mailing_list = 1
end sub
sub db_select_confirm_email
end sub
sub db_insert_confirm_email
sql = ""
'response.write sql
on error resume next
cn.Execute(sql)
if err.Number <> 0 then
b_error = true
else
end if
on error goto 0
end sub
sub db_update_confirm_email
sql = ""
'response.write sql
on error resume next
cn.execute(sql)
if err.number <> 0 then
b_error = true
end if
on error goto 0
end sub
sub db_delete_confirm_email
sql = ""
'response.write sql
on error resume next
cn.Execute(sql)
if err.number <> 0 then
b_error = true
end if
on error goto 0
end sub
sub db_select_register
sql = "SELECT " & _ "dtInserted, " & _ "accesslevel, " & _ "user_id, " & _ "user_name, " & _ "f_name, " & _ "l_name, " & _ "email, " & _ "password, " & _ "addr1, " & _ "addr2, " & _ "city, " & _ "state, " & _ "postalcode, " & _ "country, " & _ "phone, " & _ "mailing_list, " & _ "notes FROM Users" & _ " WHERE " & _ "Users.user_id = " & to_sql(user_id,"number") & ""
on error resume next
set rs = cn.Execute(sql)
if err.number <> 0 then
b_error = true
error_list.add "select_data_register", "The data selection failed. " & err.description
elseif rs.EOF then
b_results = false
msg_list.add "select_data_register", "The record was removed from the database."
else
reg_code = rs("reg_code")
dtInserted = rs("dtInserted")
accesslevel = rs("accesslevel")
user_id = rs("user_id")
user_name = rs("user_name")
f_name = rs("f_name")
l_name = rs("l_name")
email = rs("email")
password = rs("password")
addr1 = rs("addr1")
addr2 = rs("addr2")
city = rs("city")
state = rs("state")
postalcode = rs("postalcode")
country = rs("country")
phone = rs("phone")
mailing_list = rs("mailing_list")
notes = rs("notes")
end if
rs.Close
on error goto 0
end sub
sub db_insert_register
sql = "INSERT INTO Users" & _ "(" & _ "user_name," & _ "f_name," & _ "l_name," & _ "[email]," & _ "[password]," & _ "addr1," & _ "addr2," & _ "city," & _ "[state]," & _ "postalcode," & _ "country," & _ "phone," & _ "[notes]," & _ "dtInserted," & _ "dtModified," & _ "accesslevel," & _ "confirmed," & _ "mailing_list" & _ ") VALUES (" & _ "" & to_sql(user_name,"text") & "," & _ "" & to_sql(f_name,"text") & "," & _ "" & to_sql(l_name,"text") & "," & _ "" & to_sql(email,"text") & "," & _ "" & to_sql(password,"text") & "," & _ "" & to_sql(addr1,"text") & "," & _ "" & to_sql(addr2,"text") & "," & _ "" & to_sql(city,"text") & "," & _ "" & to_sql(state,"text") & "," & _ "" & to_sql(postalcode,"text") & "," & _ "" & to_sql(country,"text") & "," & _ "" & to_sql(phone,"text") & "," & _ "" & to_sql(notes,"text") & "," & _ "" & to_sql(now,"date") & "," & _ "" & to_sql(now,"date") & "," & _ "1," & _ "1," & _ "" & to_sql(mailing_list,"number") & ")"
'response.write sql
on error resume next
cn.Execute(sql)
if err.Number <> 0 then
b_error = true
error_list.add "db_insert_register" & err.Number ,"The database insert failed. " & err.Description
else
set rs = cn.Execute("SELECT @@IDENTITY")
user_id = rs(0)
rs.Close
msg_list.add "db_insert_register","The database insert was successful." end if
on error goto 0
end sub
sub db_update_register
sql = "UPDATE Users SET " & _ "dtInserted = " & to_sql(now(),"date") & ", " & _ "user_name = " & to_sql(user_name,"text") & ", " & _ "f_name = " & to_sql(f_name,"text") & ", " & _ "l_name = " & to_sql(l_name,"text") & ", " & _ "[email] = " & to_sql(email,"text") & ", " & _ "[password] = " & to_sql(password,"text") & ", " & _ "addr1 = " & to_sql(addr1,"text") & ", " & _ "addr2 = " & to_sql(addr2,"text") & ", " & _ "city = " & to_sql(city,"text") & ", " & _ "state = " & to_sql(state,"text") & ", " & _ "postalcode = " & to_sql(postalcode,"text") & ", " & _ "country = " & to_sql(country,"text") & ", " & _ "phone = " & to_sql(phone,"text") & ", " & _ "mailing_list = " & to_sql(mailing_list,"number") & ", " & _ "notes = " & to_sql(notes,"text") & " WHERE " & _ "user_id = " & to_sql(user_id,"number") & ""
'response.write sql
on error resume next
cn.execute(sql)
if err.number <> 0 then
b_error = true
error_list.add "db_update_register" & err.Number ,"The database update failed. " & err.Description
else
end if
on error goto 0
end sub
sub db_delete_register
sql = "DELETE FROM Users" & _ " WHERE " & _ "user_id = " & to_sql(user_id,"number") & ""
'response.write sql
on error resume next
cn.Execute(sql)
if err.number <> 0 then
b_error = true
error_list.add "db_delete_register" & err.Number ,"The database deletion failed. " & err.Description
else
msg_list.add "db_delete_register","The record was removed."
end if
on error goto 0
end sub
do_search = request("do_search")
sortby = request("sortby")
''' request form keys and inputs
email_address = request("email_address")
user_id = request("user_id")
reg_code = request("reg_code")
email = request("email")
':: request action
action = lcase(request("action"))
':: handle the action
select case action
case "select_confirm_email"
' select the requested key record from database
if email_address <> "" then
db_select_confirm_email
else
b_error = true
error_list.add "edit_confirm_email", "Specify record to select."
end if
case "insert_confirm_email"
' request form data and insert a new record into database
validate_confirm_email
if not b_error then
db_insert_confirm_email
end if
case "update_confirm_email"
' request form data and update an existing database record
validate_confirm_email
if not b_error then
if email_address <> "" then
db_update_confirm_email
else
b_error = true
error_list.add "update_confirm_email", "Specify record to update."
end if
end if
case "delete_confirm_email"
' delete the requested key database record
if email_address <> "" then
db_delete_confirm_email
response.redirect request.servervariables("script_name") & "?msg=The+record+was+deleted."
else
b_error = true
error_list.add "delete_confirm_email", "Specify record to delete."
end if
case "select_register"
' select the requested key record from database
if user_id <> "" then
db_select_register
else
b_error = true
error_list.add "edit_register", "Specify record to select."
end if
case "insert_register"
' request form data and insert a new record into database
validate_register
if not b_error then
':: compare decrypted reg_code with email
if application("enable_regcode") AND reg_code<>"" AND (lcase(email) <> lcase(DecryptString(reg_code))) then
b_error = true
error_list.add "bademail", "Please specify the same email address as requested with your registration code"
else
':: call sub in page load section
insert_or_update_user
end if
end if
case "update_register"
' request form data and update an existing database record
validate_register
if not b_error then
if user_id <> "" then
db_update_register
else
b_error = true
error_list.add "update_register", "Specify record to update."
end if
end if
case "delete_register"
' delete the requested key database record
if user_id <> "" then
db_delete_register
response.redirect request.servervariables("script_name") & "?msg=The+record+was+deleted."
else
b_error = true
error_list.add "delete_register", "Specify record to delete."
end if
case "send_reg_code"
':: send validation email to the requested email address
':: encrypt email string to create reg_code
reg_code = EncryptString(email_address)
':: compose message with return link
site_root = application("site_root")
user_name = email_address
email = email_address
subject = "Registration Code"
body = "Click the link below to complete your registration:" & chr(10)
':: (text only) body = body + site_root + "register.asp?reg_code=" & reg_code
body = body + " complete my registration for '" & email & "'..."
':: send mail
retv = SendMail(NULL, user_name, email, sender_name, sender_address, subject, body)
if retv = 1 then
msg_list.add "mailsent", "Your registration code has been sent to " & email_address
display_regcode_sent = true
else
b_error = true
error_list.add "sendfailed", "Error: A registration code was not sent."
end if
end select
':: handle the default case(s) (ignores value of action parameter)
if application("enable_regcode") AND reg_code="" AND email="" then
display_confirm_email = TRUE
elseif user_id <> "" then
':: select existing record to populate form
db_select_register
else
get_defaults_register
end if
%>
<%
display_errs
display_msg
%>
<% if display_confirm_email then %>
<%
':: check if hide form var was set
if not b_hide_confirm_email then
%>
Obtain a registration code
<%
':: end hide form if
end if
%>
<% elseif display_regcode_sent then %>
Thanks. An email has been sent to "<% =email %>" that contains a link to the registration page. Click this link to complete your registration.
<% else %>
<%
':: check if hide form var was set
if not b_hide_register then
%>
<% =application("lbl_register") %>
<%
':: end hide form if
end if
%>
<% end if %>
<%
':: assure that any db resources are freed
on error resume next
rs.Close
set rs = NOTHING
cn.Close
set cn = NOTHING
user_cn.Close
set user_cn = NOTHING
on error goto 0
%>