<%
'#################################################################################
'## Copyright (C) 2000-02 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## reinhold@bigfoot.com
'##
'## or
'##
'## Snitz Communications
'## C/O: Michael Anderson
'## PO Box 200
'## Harpswell, ME 04079
'#################################################################################
%>
<%
Dim strURLError
Response.Write " " & vbNewLine & _
" " & vbNewLine & _
" " & getCurrentIcon(strIconFolderOpen,"","") & " " & fLang(strLangRegister00010) & "
" & vbNewLine & _
" " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " " & fLang(strLangRegister00020) & "
" & vbNewLine & _
" " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " " & fLangN(strLangRegister00030,strForumTitle) & " | " & vbNewLine & _
"
" & vbNewLine & _
"
" & vbNewLine
if strProhibitNewMembers <> "1" then
if Request.QueryString("mode") <> "DoIt" and Request.QueryString("actkey") = "" then
if InStr(Request.ServerVariables("HTTP_REFERER"), "policy.asp") = 0 then
Response.Redirect("policy.asp")
end if
if strAuthType = "nt" and ChkAccountReg = "1" then
Response.Write " " & fLang(strLangRegister00040) & "
" & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" - " & fLang(strLangRegister00050) & "
| " & vbNewLine & _
"
" & vbNewLine & _
"
" & vbNewLine
WriteFooter
Response.End
end if
if strUseExtendedProfile then
strColspan = " colspan=""2"""
else
strColspan = ""
end if
call ShowForm
'################################ E-mail Validation Mod #################################
elseif Request.QueryString("actkey") <> "" and lcase(strEmail) = "1" and strEmailVal = "1" then
key = chkString(Request.QueryString("actkey"),"SQLString")
'###Forum_SQL
strSql = "SELECT M_NAME, M_USERNAME, M_PASSWORD, M_KEY, M_LEVEL, M_EMAIL, M_DATE, M_COUNTRY, M_AIM, M_ICQ, M_MSN, M_YAHOO" & _
", M_POSTS, M_HOMEPAGE, M_LASTHEREDATE, M_STATUS, M_RECEIVE_EMAIL, M_LAST_IP, M_IP, M_SIG, M_VIEW_SIG, M_SIG_DEFAULT" & _
", M_FIRSTNAME, M_LASTNAME, M_CITY, M_STATE, M_PHOTO_URL, M_LINK1, M_LINK2, M_AGE, M_DOB, M_MARSTATUS, M_SEX, M_OCCUPATION" & _
", M_BIO, M_HOBBIES, M_LNEWS, M_QUOTE, M_SHA256" & _
" FROM " & strMemberTablePrefix & "MEMBERS_PENDING" & _
" WHERE M_KEY = '" & key & "'"
set rsKey = my_Conn.Execute (strSql)
if rsKey.EOF or rsKey.BOF then '## activation key not found
'Error message to user
Response.Write " " & fLang(strLangRegister00060) & "
" & vbNewLine & _
" " & fLangN(strLangRegister00070, "" & "|" & "") & "
" & vbNewLine & _
" " & fLang(strLangRegister00080) & "
" & vbNewLine
elseif strComp(key,rsKey("M_KEY")) <> 0 then
'Error message to user
Response.Write " " & fLang(strLangRegister00090) & "
" & vbNewLine & _
" " & fLangN(strLangRegister00100, "" & "|" & "") & "
" & vbNewLine & _
" " & fLang(strLangRegister00080) & "
" & vbNewLine
else
'## Forum_SQL
strSql = "INSERT INTO " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & "(M_NAME"
strSql = strSql & ", M_USERNAME"
strSql = strSql & ", M_PASSWORD"
strSql = strSql & ", M_LEVEL"
strSql = strSql & ", M_EMAIL"
strSql = strSql & ", M_DATE"
strSql = strSql & ", M_COUNTRY"
strSql = strSql & ", M_AIM"
strSql = strSql & ", M_ICQ"
strSql = strSql & ", M_MSN"
strSql = strSql & ", M_YAHOO"
strSql = strSql & ", M_POSTS"
strSql = strSql & ", M_HOMEPAGE"
strSql = strSql & ", M_LASTHEREDATE"
strSql = strSql & ", M_STATUS"
strSql = strSql & ", M_RECEIVE_EMAIL"
strSql = strSql & ", M_LAST_IP"
strSql = strSql & ", M_IP"
strSql = strSql & ", M_SIG"
strSql = strSql & ", M_VIEW_SIG"
strSql = strSql & ", M_SIG_DEFAULT"
strSql = strSql & ", M_FIRSTNAME"
strSql = strSql & ", M_LASTNAME"
strSql = strSql & ", M_CITY"
strSql = strSql & ", M_STATE"
strSql = strSql & ", M_PHOTO_URL"
strSql = strSql & ", M_LINK1"
strSql = strSql & ", M_LINK2"
strSql = strsql & ", M_AGE"
strSql = strsql & ", M_DOB"
strSql = strSql & ", M_MARSTATUS"
strSql = strsql & ", M_SEX"
strSql = strSql & ", M_OCCUPATION"
strSql = strSql & ", M_BIO"
strSql = strSql & ", M_HOBBIES"
strsql = strsql & ", M_LNEWS"
strSql = strSql & ", M_QUOTE"
strSql = strSql & ", M_SHA256"
strSql = strSql & ") "
strSql = strSql & " VALUES ("
strSql = strSql & "'" & chkString(rsKey("M_NAME"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_USERNAME"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_PASSWORD"),"SQLString") & "'"
strSql = strSql & ", " & "1"
strSql = strSql & ", '" & chkString(rsKey("M_EMAIL"),"SQLString") & "'"
strSql = strSql & ", '" & DateToStr(strForumTimeAdjust) & "'"
strSql = strSql & ", '" & chkString(rsKey("M_COUNTRY"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_AIM"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_ICQ"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_MSN"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_YAHOO"),"SQLString") & "'"
strSql = strSql & ", 0"
strSql = strSql & ", '" & chkString(rsKey("M_HOMEPAGE"),"SQLString") & "'"
strSql = strSql & ", '" & DateToStr(strForumTimeAdjust) & "'"
strSql = strSql & ", 1"
strSql = strSql & ", '" & chkString(rsKey("M_RECEIVE_EMAIL"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_LAST_IP"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_IP"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_SIG"),"message") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_VIEW_SIG"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_SIG_DEFAULT"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_FIRSTNAME"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_LASTNAME"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_CITY"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_STATE"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_PHOTO_URL"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_LINK1"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_LINK2"),"SQLString") & "'"
strSql = strsql & ", '" & chkString(rsKey("M_AGE"),"SQLString") & "'"
strSql = strsql & ", '" & chkString(rsKey("M_DOB"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_MARSTATUS"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_SEX"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_OCCUPATION"),"SQLString") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_BIO"),"message") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_HOBBIES"),"message") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_LNEWS"),"message") & "'"
strSql = strSql & ", '" & chkString(rsKey("M_QUOTE"),"message") & "'"
strSql = strSql & ", 1"
strSql = strSql & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
Call DoCount
'## Forum_SQL - Delete the Member
strSql = "DELETE FROM " & strMemberTablePrefix & "MEMBERS_PENDING "
strSql = strSql & " WHERE M_KEY = '" & key & "'"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
Response.Write " " & fLang(strLangRegister00110) & "
" & vbNewLine & _
" " & fLang(strLangRegister00120)
if strAuthType="db" then Response.Write(fLang(strLangRegister00130))
Response.Write ".
" & vbNewLine & _
" " & fLang(strLangRegister00080) & "
" & vbNewLine
end if
rsKey.close
set rsKey = nothing
'#####################################################################################
else
strEncodedPassword = sha256("" & trim(Request.Form("Password")))
Err_Msg = ""
if strAutoLogon <> 1 then
if trim(Request.Form("Name")) = "" then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00140) & ""
end if
end if
'## Forum_SQL
strSql = "SELECT M_NAME FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_NAME = '" & ChkString(Trim(Request.Form("Name")), "SQLString") &"'"
set rs = my_Conn.Execute (strSql)
if rs.BOF and rs.EOF then
'## Do Nothing
else
Err_Msg = Err_Msg & "" & fLang(strLangRegister00150) & ""
end if
rs.close
set rs = nothing
if strEmail = "1" and strEmailVal = "1" then
'## Forum_SQL
strSql = "SELECT M_NAME FROM " & strMemberTablePrefix & "MEMBERS_PENDING "
strSql = strSql & " WHERE M_NAME = '" & ChkString(Trim(Request.Form("Name")), "SQLString") &"'"
set rs = my_Conn.Execute (strSql)
if rs.BOF and rs.EOF then
'## Do Nothing
else
Err_Msg = Err_Msg & "" & fLang(strLangRegister00150) & ""
end if
rs.close
set rs = nothing
end if
if strUserNameFilter = "1" then
chkNameFilter(trim(Request.Form("Name")))
end if
if strBadWordFilter = "1" then
chkNameBadWords(trim(Request.Form("Name")))
end if
if not IsValidString(trim(Request.Form("Name"))) then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00160) & " !#$%^&*()=+{}[]|\;:/?>,<' "
end if
'## NT authentication no additional password needed
if strAuthType = "db" then
if not IsValidString(trim(Request.Form("Password"))) then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00170) & " !#$%^&*()=+{}[]|\;:/?>,<' "
end if
if trim(Request.Form("Password")) = "" then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00180) & ""
end if
if Len(Request.Form("Password")) > 25 then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00190) & ""
end if
if Request.Form("Password") <> Request.Form("Password2") then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00200) & ""
end if
end if
If strAutoLogon <> 1 then
if Request.Form("Email") = "" then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00210) & ""
end if
if Request.Form("Email") <> Request.Form("Email3") then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00220) & ""
end if
if EmailField(Request.Form("Email")) = 0 then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00230) & ""
end if
end if
if strMSN = "1" and trim(Request.Form("MSN")) <> "" then
if EmailField(Request.Form("MSN")) = 0 then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00240) & ""
end if
end if
if strAuthType = "nt" and ChkAccountReg = "true" then
Err_Msg = Err_Msg & "" & fLang(strLangRegister00250) & ""
end if
if strUniqueEmail = "1" then
'## Forum_SQL
strSql = "SELECT M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_EMAIL = '" & Trim(chkString(Request.Form("Email"),"SQLString")) &"'"
set rs = my_Conn.Execute(TopSQL(strSql,1))
if rs.BOF and rs.EOF then
'## Do Nothing
else
Err_Msg = Err_Msg & "" & fLang(strLangRegister00260) & ""
end if
set rs = nothing
if strEmail = "1" and strEmailVal = "1" then
'## Forum_SQL
strSql = "SELECT M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS_PENDING "
strSql = strSql & " WHERE M_EMAIL = '" & Trim(chkString(Request.Form("Email"),"SQLString")) &"'"
set rs = my_Conn.Execute(TopSQL(strSql,1))
if rs.BOF and rs.EOF then
'## Do Nothing
else
Err_Msg = Err_Msg & "" & fLang(strLangRegister00260) & ""
end if
set rs = nothing
'## Forum_SQL
strSql = "SELECT M_NEWEMAIL FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_NEWEMAIL = '" & Trim(ChkString(Request.Form("Email"),"SQLString")) &"'"
set rs = my_Conn.Execute(TopSQL(strSql,1))
if rs.BOF and rs.EOF then
'## Do Nothing
else
Err_Msg = Err_Msg & "" & fLang(strLangRegister00260) & ""
end if
set rs = nothing
end if
end if
if not IsValidURL(trim(Request.Form("Homepage"))) then
Err_Msg = Err_Msg & "" & fLangN(strLangRegister00270,strURLError) & ""
end if
if not IsValidURL(trim(Request.Form("LINK1"))) then
Err_Msg = Err_Msg & "" & fLangN(strLangRegister00280,strURLError) & ""
end if
if not IsValidURL(trim(Request.Form("LINK2"))) then
Err_Msg = Err_Msg & "" & fLangN(strLangRegister00280,strURLError) & ""
end if
if not IsValidURL(trim(Request.Form("Photo_URL"))) then
Err_Msg = Err_Msg & "" & fLangN(strLangRegister00290,strURLError) & ""
end if
if Err_Msg = "" then
if Trim(Request.Form("Homepage")) <> "" and lcase(trim(Request.Form("Homepage"))) <> "http://" and Trim(lcase(Request.Form("Homepage"))) <> "https://" and lcase(Request.Form("Homepage")) <> "file:///" then
regHomepage = ChkString(Request.Form("Homepage"),"SQLString")
else
regHomepage = " "
end if
if Trim(Request.Form("LINK1")) <> "" and lcase(trim(Request.Form("LINK1"))) <> "http://" and Trim(lcase(Request.Form("LINK1"))) <> "https://" then
regLink1 = ChkString(Request.Form("LINK1"),"SQLString")
else
regLink1 = " "
end if
if Trim(Request.Form("LINK2")) <> "" and lcase(trim(Request.Form("LINK2"))) <> "http://" and Trim(lcase(Request.Form("LINK2"))) <> "https://" then
regLink2 = ChkString(Request.Form("LINK2"),"SQLString")
else
regLink2 = " "
end if
if Trim(Request.Form("PHOTO_URL")) <> "" and lcase(trim(Request.Form("PHOTO_URL"))) <> "http://" and Trim(lcase(Request.Form("PHOTO_URL"))) <> "https://" then
regPhoto_URL = ChkString(Request.Form("Photo_URL"),"SQLString")
else
regPhoto_URL = " "
end if
'###### E-mail Validation Mod ######
actkey = GetKey("none")
'##################################
'## Forum_SQL
strSql = "INSERT INTO " & strMemberTablePrefix
if strEmail = "1" and strEmailVal = "1" then
strSql = strSql & "MEMBERS_PENDING "
else
strSql = strSql & "MEMBERS "
end if
strSql = strSql & "(M_NAME"
if strAuthType = "nt" then
strSql = strSql & ", M_USERNAME"
end if
strSql = strSql & ", M_PASSWORD"
'######### E-mail Validation Mod ##########
if strEmail = "1" and strEmailVal = "1" then
strSql = strSql & ", M_KEY"
strSql = strSql & ", M_LEVEL"
strSql = strSql & ", M_APPROVE"
end if
'#########################################
strSql = strSql & ", M_EMAIL"
strSql = strSql & ", M_DATE"
strSql = strSql & ", M_COUNTRY"
strSql = strSql & ", M_AIM"
strSql = strSql & ", M_ICQ"
strSql = strSql & ", M_MSN"
strSql = strSql & ", M_YAHOO"
strSql = strSql & ", M_POSTS"
strSql = strSql & ", M_HOMEPAGE"
strSql = strSql & ", M_LASTHEREDATE"
strSql = strSql & ", M_STATUS"
strSql = strSql & ", M_RECEIVE_EMAIL"
strSql = strSql & ", M_LAST_IP"
strSql = strSql & ", M_IP"
strSql = strSql & ", M_SIG"
strSql = strSql & ", M_VIEW_SIG"
strSql = strSql & ", M_SIG_DEFAULT"
strSql = strSql & ", M_FIRSTNAME"
strSql = strSql & ", M_LASTNAME"
strsql = strsql & ", M_CITY"
strsql = strsql & ", M_STATE"
strsql = strsql & ", M_PHOTO_URL"
strsql = strsql & ", M_LINK1"
strSql = strSql & ", M_LINK2"
strSql = strsql & ", M_AGE"
strSql = strsql & ", M_DOB"
strSql = strSql & ", M_MARSTATUS"
strSql = strsql & ", M_SEX"
strSql = strSql & ", M_OCCUPATION"
strSql = strSql & ", M_BIO"
strSql = strSql & ", M_HOBBIES"
strsql = strsql & ", M_LNEWS"
strSql = strSql & ", M_QUOTE"
strSql = strSql & ", M_SHA256"
strSql = strSql & ") "
strSql = strSql & " VALUES ("
if strAutoLogon = "1" then
strSql = strSql & "'" & chkString(Session(strCookieURL & "strNTUserFullName"),"SQLString") & "'"
else
strSql = strSql & "'" & chkString(trim(Request.Form("Name")),"SQLString") & "'"
end if
if strAuthType = "nt" then
strSql = strSql & ", " & "'" & chkString(strDBNTUserName,"SQLString") & "'"
end if
strSql = strSql & ", " & "'" & chkString(strEncodedPassword,"password") & "'"
'################## E-mail Validation Mod ########################
if strEmail = "1" and strEmailVal = "1" then
strSql = strSql & ", " & "'" & chkString(actkey,"") & "'"
strSql = strSql & ", " & "-1"
if strRestrictReg = "1" then
strSql = strSql & ", " & "0"
else
strSql = strSql & ", " & "1"
end if
end if
'################################################################
strSql = strSql & ", " & "'" & chkString(Request.Form("Email"),"SQLString") & "'"
strSql = strSql & ", " & "'" & DateToStr(strForumTimeAdjust) & "'"
strSql = strSql & ", " & "'" & chkString(Request.Form("Country"),"SQLString") & "'"
strSql = strSql & ", " & "'" & chkString(Request.Form("AIM"),"SQLString") & "'"
strSql = strSql & ", " & "'" & chkString(Request.Form("ICQ"),"SQLString") & "'"
strSql = strSql & ", " & "'" & chkString(Request.Form("MSN"),"SQLString") & "'"
strSql = strSql & ", " & "'" & chkString(Request.Form("YAHOO"),"SQLString") & "'"
strSql = strSql & ", " & "0"
strSql = strSql & ", " & "'" & chkString(Trim(regHomepage),"SQLString") & "'"
strSql = strSql & ", " & "'" & DateToStr(strForumTimeAdjust) & "'"
'################## E-mail Validation Mod ########################
if strEmail = "1" and strEmailVal = "1" then
strSql = strSql & ", " & "0"
else
strSql = strSql & ", " & "1"
end if
'strSql = strSql & ", " & "1"
'################################################################
strSql = strSql & ", '" & chkString(Request.Form("ReceiveEMail"),"SQLString") & "'"
strSql = strSql & ", '" & Request.ServerVariables("REMOTE_ADDR") & "'"
strSql = strSql & ", '" & Request.ServerVariables("REMOTE_ADDR") & "'"
if strSignatures = "1" then
strSql = strSql & ", " & "'" & chkString(Request.Form("Sig"),"message") & "'"
else
strsql = strsql & ", ''"
end if
if strSignatures = "1" and strDSignatures = "1" then
strSql = strSql & ", " & cLng(Request.Form("ViewSig"))
else
strsql = strsql & ", " & 1
end if
if strSignatures = "1" then
strSql = strSql & ", " & cLng(Request.Form("fSigDefault"))
else
strsql = strsql & ", " & 1
end if
if strFullName = "1" then
strSql = strSql & ", '" & ChkString(Request.Form("FirstName"),"SQLString") & "'"
strSql = strSql & ", '" & ChkString(Request.Form("LastName"),"SQLString") & "'"
else
strSql = strSql & ", ''"
strSql = strSql & ", ''"
end if
if strCity = "1" then
strsql = strsql & ", '" & ChkString(Request.Form("City"),"SQLString") & "'"
else
strsql = strsql & ", ''"
end if
if strState = "1" then
strsql = strsql & ", '" & ChkString(Request.Form("State"),"SQLString") & "'"
else
strsql = strsql & ", ''"
end if
if strPicture = "1" then
strsql = strsql & ", '" & ChkString(Trim(regPhoto_URL),"SQLString") & "'"
else
strsql = strsql & ", ''"
end if
if strFavLinks = "1" then
strsql = strsql & ", '" & ChkString(Trim(regLink1),"SQLString") & "'"
strSql = strSql & ", '" & ChkString(Trim(regLink2),"SQLString") & "'"
else
strsql = strsql & ", ''"
strSql = strSql & ", ''"
end if
if strAge = "1" then
strSql = strsql & ", '" & ChkString(Request.Form("Age"),"SQLString") & "'"
else
strSql = strsql & ", ''"
end if
if strAgeDOB = "1" then
strSql = strsql & ", '" & ChkString(Request.Form("AgeDOB"),"SQLString") & "'"
else
strSql = strsql & ", ''"
end if
if strMarStatus = "1" then
strSql = strSql & ", '" & ChkString(Request.Form("MarStatus"),"SQLString") & "'"
else
strSql = strSql & ", ''"
end if
if strSex = "1" then
strSql = strsql & ", '" & ChkString(Request.Form("Sex"),"SQLString") & "'"
else
strSql = strSql & ", ''"
end if
if strOccupation = "1" then
strSql = strSql & ", '" & ChkString(Request.Form("Occupation"),"SQLString") & "'"
else
strSql = strSql & ", ''"
end if
if strBio = "1" then
strSql = strSql & ", '" & ChkString(Request.Form("Bio"),"message") & "'"
else
strSql = strSql & ", ''"
end if
if strHobbies = "1" then
strSql = strSql & ", '" & ChkString(Request.Form("Hobbies"),"message") & "'"
else
strSql = strSql & ", ''"
end if
if strLNews = "1" then
strsql = strsql & ", '" & ChkString(Request.Form("LNews"),"message") & "'"
else
strSql = strSql & ", ''"
end if
if strQuote = "1" then
strSql = strSql & ", '" & ChkString(Request.Form("Quote"),"message") & "'"
else
strSql = strSql & ", ''"
end if
strSql = strSql & ", 1"
strSql = strSql & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if strEmail = "1" and strEmailVal = "1" then
'Do Nothing
else
Call DoCount
end if
regHomepage = ""
if strEmail = "1" and strRestrictReg = "0" then
'## E-mails Message to the Author of this Reply.
strRecipientsName = Request.Form("Name")
strRecipients = Request.Form("Email")
strFrom = strSender
strFromName = strForumTitle
strsubject = fLangN(strLangRegister00300, strForumTitle) & " "
strMessage = fLangN(strLangRegister00310,Request.Form("name")) & vbNewline & vbNewline
strMessage = strMessage & fLangN(strLangRegister00320, strForumTitle & "|" & strForumURL) & vbNewline & vbNewline
if strAuthType="db" then
'################################### E-mail Validation Mod #################################
if strEmailVal = "1" then
strMessage = strMessage & fLang(strLangRegister00330) & vbNewline & vbNewLine
strMessage = strMessage & strForumURL & "register.asp?actkey=" & actkey & vbNewline & vbNewline
else
'######################################################################################
strMessage = strMessage & fLang(strLangRegister00340) & " " & Request.Form("Password") & vbNewline & vbNewline
end if '<---- E-mail Validation Mod - 1 line #############
end if
strMessage = strMessage & fLang(strLangRegister00350) & vbNewline & vbNewline
strMessage = strMessage & fLang(strLangRegister00360)
%>
<%
end if
else
Response.Write " " & fLang(strLangRegister00370) & "
" & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" | " & vbNewLine & _
"
" & vbNewLine & _
"
" & vbNewLine & _
" " & fLang(strLangRegister00380) & "
" & vbNewLine
WriteFooter
Response.End
end if
' ##################### E-mail Validation Mod #########################
if lcase(strEmail) = "0" then
Response.Write " " & fLang(strLangRegister00110) & "
" & vbNewLine & _
" " & fLang(strLangRegister00120)
if strAuthType = "db" then Response.Write(fLang(strLangRegister00130))
Response.Write ".
" & vbNewLine
else
if strEmailVal = "1" then
Response.Write " " & fLang(strLangRegister00390) & "
" & vbNewLine
'#######################################
if strRestrictReg = "1" then
Response.Write " " & fLang(strLangRegister00400) & "
" & vbNewLine
else
Response.Write " " & fLangN(strLangRegister00410, "" & ChkString(Request.Form("Email"),"email") & "") & "
" & vbNewLine
end if
'#######################################
else
Response.Write " " & fLang(strLangRegister00110) & "
" & vbNewLine & _
" " & fLang(strLangRegister00120)
if strAuthType = "db" then Response.Write(fLang(strLangRegister00130))
Response.Write ".
" & vbNewLine
end if
end if
' #######################################################################
if strAuthType = "db" then
select case chkUser(Request.Form("Name"), Request.Form("Password"),-1)
case 1, 2, 3, 4
Call DoCookies("false")
strLoginStatus = 1
case else
strLoginStatus = 0
end select
end if
if strAutoLogon = 1 then
Response.Redirect "default.asp"
else
Response.Write " " & vbNewLine
end if
Response.Write " " & fLang(strLangRegister00080) & "
" & vbNewLine
end if
else
Response.Write "
" & fLang(strLangRegister00420) & "
" & vbNewLine & _
" " & vbNewLine & _
" " & fLang(strLangRegister00080) & "
" & vbNewLine
end if
WriteFooter
Response.End
sub DoCount
'## Forum_SQL - Updates the Totals table by adding 1 to U_COUNT
strSql = "UPDATE " & strTablePrefix & "TOTALS "
strSql = strSql & " SET " & strTablePrefix & "TOTALS.U_COUNT = " & strTablePrefix & "TOTALS.U_COUNT + 1"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
end sub
sub ShowForm()
Response.Write " " & vbNewLine
end sub
Function IsValidURL(sValidate)
Dim sInvalidChars
Dim bTemp
Dim i
if trim(sValidate) = "" then IsValidURL = true : exit function
sInvalidChars = """;+()*'<>"
for i = 1 To Len(sInvalidChars)
if InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 then bTemp = True
if bTemp then strURLError = "
• " & fLang(strLangRegister00430) & " "" ; + ( ) * ' < > "
if bTemp then Exit For
next
if not bTemp then
for i = 1 to Len(sValidate)
if Asc(Mid(sValidate, i, 1)) = 160 then bTemp = True
if bTemp then strURLError = "
• " & fLang(strLangRegister00440)
if bTemp then Exit For
next
end if
' extra checks
' check to make sure URL begins with http:// or https://
if not bTemp then
bTemp = (lcase(left(sValidate, 7)) <> "http://") and (lcase(left(sValidate, 8)) <> "https://")
if bTemp then strURLError = "
• " & fLang(strLangRegister00450)
end if
' check to make sure URL is 255 characters or less
if not bTemp then
bTemp = len(sValidate) > 255
if bTemp then strURLError = "
• " & fLang(strLangRegister00460)
end if
' no two consecutive dots
if not bTemp then
bTemp = InStr(sValidate, "..") > 0
if bTemp then strURLError = "
• " & fLang(strLangRegister00470)
end if
'no spaces
if not bTemp then
bTemp = InStr(sValidate, " ") > 0
if bTemp then strURLError = "
• " & fLang(strLangRegister00440)
end if
if not bTemp then
bTemp = (len(sValidate) <> len(Trim(sValidate)))
if bTemp then strURLError = "
• " & fLang(strLangRegister00440)
end if 'Addition for leading and trailing spaces
' if any of the above are true, invalid string
IsValidURL = Not bTemp
End Function
Function IsValidString(sValidate)
Dim sInvalidChars
Dim bTemp
Dim i
' Disallowed characters
sInvalidChars = "!#$%^&*()=+{}[]|\;:/?>,<'"
for i = 1 To Len(sInvalidChars)
if InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 then bTemp = True
if bTemp then Exit For
next
for i = 1 to Len(sValidate)
if Asc(Mid(sValidate, i, 1)) = 160 then bTemp = True
if bTemp then Exit For
next
' extra checks
' no two consecutive dots or spaces
if not bTemp then
bTemp = InStr(sValidate, "..") > 0
end if
if not bTemp then
bTemp = InStr(sValidate, " ") > 0
end if
if not bTemp then
bTemp = (len(sValidate) <> len(Trim(sValidate)))
end if 'Addition for leading and trailing spaces
' if any of the above are true, invalid string
IsValidString = Not bTemp
End Function
function chkNameFilter(pString)
if trim(Application(strCookieURL & "STRFILTERUSERNAMES")) = "" then
txtUserNames = ""
'## Forum_SQL - Get UserNames from DB
strSqln = "SELECT N_NAME "
strSqln = strSqln & " FROM " & strFilterTablePrefix & "NAMEFILTER "
set rsUName = Server.CreateObject("ADODB.Recordset")
rsUName.open strSqln, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsUName.EOF then
recUserNameCount = ""
else
allUserNameData = rsUName.GetRows(adGetRowsRest)
recUserNameCount = UBound(allUserNameData,2)
end if
rsUName.close
set rsUName = nothing
if recUserNameCount <> "" then
nNAME = 0
for iUserName = 0 to recUserNameCount
UserNameName = allUserNameData(nNAME,iUserName)
if txtUserNames = "" then
txtUserNames = UserNameName
else
txtUserNames = txtUserNames & "," & UserNameName
end if
next
end if
Application.Lock
Application(strCookieURL & "STRFILTERUSERNAMES") = txtUserNames
Application.UnLock
end if
txtUserNames = Application(strCookieURL & "STRFILTERUSERNAMES")
fString = trim(pString)
unames = split(txtUserNames, ",")
for i = 0 to ubound(unames)
if instr(1,lcase(fString), lcase(unames(i)),1) <> 0 then
Err_Msg = Err_Msg & "" & fLangN(strLangRegister00480,unames(i)) & ""
exit function
end if
next
end function
function chkNameBadWords(pString)
if trim(Application(strCookieURL & "STRBADWORDWORDS")) = "" or trim(Application(strCookieURL & "STRBADWORDREPLACE")) = "" then
txtBadWordWords = ""
txtBadWordReplace = ""
'## Forum_SQL - Get Badwords from DB
strSqlb = "SELECT B_BADWORD, B_REPLACE "
strSqlb = strSqlb & " FROM " & strFilterTablePrefix & "BADWORDS "
set rsBadWord = Server.CreateObject("ADODB.Recordset")
rsBadWord.open strSqlb, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsBadWord.EOF then
recBadWordCount = ""
else
allBadWordData = rsBadWord.GetRows(adGetRowsRest)
recBadWordCount = UBound(allBadWordData,2)
end if
rsBadWord.close
set rsBadWord = nothing
if recBadWordCount <> "" then
bBADWORD = 0
bREPLACE = 1
for iBadword = 0 to recBadWordCount
BadWordWord = allBadWordData(bBADWORD,iBadWord)
BadWordReplace = allBadWordData(bREPLACE,iBadWord)
if txtBadWordWords = "" then
txtBadWordWords = BadWordWord
txtBadWordReplace = BadWordReplace
else
txtBadWordWords = txtBadWordWords & "," & BadWordWord
txtBadWordReplace = txtBadWordReplace & "," & BadWordReplace
end if
next
end if
Application.Lock
Application(strCookieURL & "STRBADWORDWORDS") = txtBadWordWords
Application(strCookieURL & "STRBADWORDREPLACE") = txtBadWordReplace
Application.UnLock
end if
txtBadWordWords = Application(strCookieURL & "STRBADWORDWORDS")
fString = trim(pString)
bwords = split(txtBadWordWords, ",")
for i = 0 to ubound(bwords)
if instr(1,lcase(fString), lcase(bwords(i)),1) <> 0 then
Err_Msg = Err_Msg & "" & fLangN(strLangRegister00480,bwords(i)) & ""
exit function
end if
next
end function
%>