<% dim RootCategorymain RootCategorymain = 2 %> <% dim connmain dim cstmain dim UserConnmain dim UserConnString ' open database connection to be used on page cstmain = Application("constring") 'cstmain = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ 'server.mappath ("/") & "..\db\landscapeguides.mdb;" set connmain = CreateObject("ADODB.Connection") connmain.open cstmain 'Get current top active categories ' open database connection to be used on page set UserConnmain=server.createobject("adodb.connection") UserConnmainString = Application("constring") 'UserConnmainString = "DRIVER={Microsoft Access Driver (*.mdb)}; " & _ ' "DBQ=" & server.mappath ("/") & "..\db\userslandscape.mdb;" UserConnmain.open UserConnmainString 'Get current top active categories session("URMode")=request.QueryString("Rmode") dim ThisCategory RootCategorymain = 2 if Request.QueryString("BookID")>"" then dim SQLGetFirstCat, RSGetFirstCat SQLGetFirstCat = "SELECT TOP 1 Books.BookID, Categories.CategoryID " &_ "FROM Categories INNER JOIN (Books INNER JOIN BooksAndCategories ON Books.BookID = BooksAndCategories.BookID) " &_ "ON Categories.CategoryID = BooksAndCategories.CategoryID " &_ "WHERE (((Books.BookID)=" & Request.Querystring("BookID") & "));" set RSGetFirstCat=connmain.execute(SQLGetFirstCat) if not RSGetFirstCat.EOF then ThisCategory = RSGetFirstCat("CategoryID") else ThisCategory = 2 end if else ThisCategory=Request.QueryString("CatID") if isnull(ThisCategory) or ThisCategory="" then ThisCategory=2 end if dim RSCategory dim SQLCategory if cint(RootCategorymain) = cint(thiscategory) then SQLCategory="SELECT Categories.CategoryID, Categories.CategoryName, Categories.HideCategory, " & _ "Categories.ActiveFrom, Categories.ActiveUntil, Categories.ParentCategory " & _ "FROM Categories " & _ "WHERE (((Categories.HideCategory)=0) AND ((Categories.ActiveFrom)getDate()) AND ((Categories.ParentCategory)=" & RootCategorymain & ")) " & _ "ORDER BY Categories.CategoryName;" set RSCategory=connmain.execute(SQLCategory) else SQLCategory="SELECT Categories.CategoryID, Categories.CategoryName, Categories.HideCategory, Categories.CategoryCode, " & _ "Categories.ActiveFrom, Categories.ActiveUntil, Categories.ParentCategory, Categories.CategoryDescription " & _ "FROM Categories " & _ "WHERE (((Categories.HideCategory)=0) AND ((Categories.ActiveFrom)getDate()) AND ((Categories.ParentCategory)=" & RootCategorymain & ")) AND CategoryID = " & ThisCategory & " order by CategoryName" end if set RSCategory=connmain.execute(SQLCategory) %> Landscape-guides forum - Registration <% Dim strURLError if Request.Form("policy_accept") = "true" then Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
" & vbNewLine & _ "

"& getCurrentIcon(strIconFolderOpen,"","") & " All Forums
" & vbNewLine & _ " " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Registration Rules and Policies Agreement
" & vbNewLine & _ " " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Registration Form for " & strForumTitle & "

" & vbNewLine end if if strProhibitNewMembers <> "1" then if Request.QueryString("mode") <> "DoIt" and Request.QueryString("actkey") = "" then if Request.Form("policy_accept") <> "true" then %> <% end if if strAuthType = "nt" and ChkAccountReg = "1" then Response.Write "

Registration for this account is not necessary.

" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
  • This NT User account has already been registered.
" & vbNewLine WriteFooter %>


 

 

::Ad Center::

paypal


We Buy & Sell, Books, Prints & photographs, Rare, Old & Unique, at mumfordbooks.co.uk
UK's leading Family Bookstore with Quick Easy Ordering.
Books and Images, for the Whole Family, an online Catalogue for Collectors
NEW web site under construction seascape-guides.co.uk


Discover your Welsh Roots and UK’s Heritage
Walking and Cycling Maps with your own interactive Area Routes,
making it easier and more enjoyable for people to walk, and to promote the benefits of walking.
landscape-guides.co.uk

 

We hope that you enjoy your visit to landscape-guides - why not add this site to your Favourites so
that you can easily check for our latest additions!



All of our checkout pages and any page on our site that asks for personal information from our customers is protected by SSL encryption.

SSL
catalogue
SSL Secured

<% response.write "

" if Session("BasketItems") > 0 then response.write "" response.write "
" response.write "
full basket" & Session("BasketItems") & " items
View basket
" else response.write "" response.write "
empty basketYour
Shopping
Basket is
ready
" end if %>

Login here

Purchase Online
Quick Downloads
Light Watermarks

 

Selections from our Stock

<% Dim SQLGetThumbList9, RSGetThumbList9, ThumbCount9 SQLGetThumbList9 = "SELECT distinct Books.BookID, Books.ThumbFile, Books.Title FROM Books " &_ "WHERE (((Books.Hide)=0) AND ((Books.HasThumb)=1) AND ((Books.Sold)=0));" set RSGetThumbList9 = server.createobject("ADODB.Recordset") RSGetThumbList9.open SQLGetThumbList9, connmain, 3, 3, 1 ThumbCount5 = RSGetThumbList9.RecordCount ' response.write ThumbCount1 & " books found" 'do until RSGetThumbList1.EOF Randomize Dim i for i=1 to 5 RSGetThumbList9.Move int(ThumbCount1*RND), 1 response.write "
book
" response.write server.htmlencode(RSGetThumbList9("Title")) response.write "

 

" ' RSGetThumbList1.movenext next 'loop %>

Home | Catalogue | Our Terms | Requests | Valuations | Feedback | Links | Search | Favourites

Valid CSS!Valid HTML 4.01 Transitional


1999-<%=year(date)%> Copyright Mike Mumford.


Data Protection Act 1998 - Data Controller Name: MIKE MUMFORD Registration Number:Z63116776
Telephone +44 (0)845 226 1769

<% 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 "

Activation Key Not Found!

" & vbNewLine & _ "

Your activation key was not found in our database.
Please try registering again by clicking the Register link at the top right hand corner.
If this problem persists, please contact the Administrator of the forums.

" & vbNewLine & _ "

Back To Forum

" & vbNewLine elseif strComp(key,rsKey("M_KEY")) <> 0 then 'Error message to user Response.Write "

Activation Key Did Not Match!

" & vbNewLine & _ "

Your activation key did not match the one that we have in our database.
Please try registering again by clicking the Register link at the top right hand corner.
If this problem persists, please contact the Administrator of the forums.

" & vbNewLine & _ "

Back To Forum

" & 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 & ", " & cLng(rsKey("M_RECEIVE_EMAIL")) & " " 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 "

Your Registration Has Been Completed!

" & vbNewLine & _ "

You may now begin posting" if strAuthType="db" then Response.Write(" using your new UserName and Password") Response.Write ".

" & vbNewLine & _ "

Back To Forum

" & vbNewLine end if rsKey.close set rsKey = nothing '##################################################################################### else strEncodedPassword = sha256("" & trim(Request.Form("Password"))) Err_Msg = "" function TestCaptcha(byval valSession, byval valCaptcha) dim tmpSession valSession = Trim(valSession) valCaptcha = Trim(valCaptcha) if (valSession = vbNullString) or (valCaptcha = vbNullString) then TestCaptcha = false else tmpSession = valSession valSession = Trim(Session(valSession)) Session(tmpSession) = vbNullString if valSession = vbNullString then TestCaptcha = false else valCaptcha = Replace(valCaptcha,"i","I") if StrComp(valSession,valCaptcha,1) = 0 then TestCaptcha = true else TestCaptcha = false end if end if end if end function if TestCaptcha("ASPCAPTCHA", Request.Form("captchacode")) then else Err_Msg = Err_Msg & "
  • You entered the wrong Captcha code
  • " end if if strAutoLogon <> 1 then if trim(Request.Form("Name")) = "" then Err_Msg = Err_Msg & "
  • You must choose a UserName
  • " end if if Len(trim(Request.Form("Name"))) < 3 then Err_Msg = Err_Msg & "
  • Your UserName must be at least 3 characters long
  • " 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 & "
  • UserName already in Use, Please Choose Another
  • " 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 & "
  • UserName already in Use, Please Choose Another
  • " 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 & "
  • You may not use any of these chars in your username !#$%^&*()=+{}[]|\;:/?>,<'
  • " end if '## NT authentication no additional password needed if strAuthType = "db" then if not IsValidString(trim(Request.Form("Password"))) then Err_Msg = Err_Msg & "
  • You may not use any of these chars in your password !#$%^&*()=+{}[]|\;:/?>,<'
  • " end if if trim(Request.Form("Password")) = "" then Err_Msg = Err_Msg & "
  • You must choose a Password
  • " end if if Len(Request.Form("Password")) > 25 then Err_Msg = Err_Msg & "
  • Your Password can not be greater than 25 characters
  • " end if if Request.Form("Password") <> Request.Form("Password2") then Err_Msg = Err_Msg & "
  • Your Passwords didn't match.
  • " end if end if If strAutoLogon <> 1 then if Request.Form("Email") = "" then Err_Msg = Err_Msg & "
  • You Must give an e-mail address
  • " end if if Request.Form("Email") <> Request.Form("Email3") then Err_Msg = Err_Msg & "
  • Your E-mail Addresses didn't match.
  • " end if if EmailField(Request.Form("Email")) = 0 then Err_Msg = Err_Msg & "
  • You Must enter a valid e-mail address
  • " end if end if if strMSN = "1" and trim(Request.Form("MSN")) <> "" then if EmailField(Request.Form("MSN")) = 0 then Err_Msg = Err_Msg & "
  • You Must enter a valid MSN Messenger Username
  • " end if end if if strAuthType = "nt" and ChkAccountReg = "true" then Err_Msg = Err_Msg & "
  • NT User Account already registered.
  • " 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 & "
  • E-mail Address already in use, Please Choose Another
  • " 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 & "
  • E-mail Address already in use, Please Choose Another
  • " 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 & "
  • E-mail Address already in use, Please Choose Another
  • " end if set rs = nothing end if end if if not IsValidURL(trim(Request.Form("Homepage"))) then Err_Msg = Err_Msg & "
  • Homepage URL: Invalid URL" & strURLError & "
  • " end if if not IsValidURL(trim(Request.Form("LINK1"))) then Err_Msg = Err_Msg & "
  • Cool Links URL: Invalid URL" & strURLError & "
  • " end if if not IsValidURL(trim(Request.Form("LINK2"))) then Err_Msg = Err_Msg & "
  • Cool Links URL: Invalid URL" & strURLError & "
  • " end if if not IsValidURL(trim(Request.Form("Photo_URL"))) then Err_Msg = Err_Msg & "
  • Photo URL: Invalid URL" & strURLError & "
  • " end if strMAge = "" if strAge = "1" then strMAge = ChkString(trim(Request.Form("Age")), "SQLString") end if if strAgeDOB = "1" then strMDOB = ChkString(Request.Form("year"), "SQLString") & ChkString(Request.Form("month"), "SQLString") & ChkString(Request.Form("day"), "SQLString") if len(strMDOB) <> 8 then strMDOB = "" else strMDOByear = cInt(left(strMDOB, 4)) strMDOBmonth = cInt(mid(strMDOB, 5, 2)) strMDOBday = cInt(right(strMDOB, 2)) arrDays = array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) intDays = arrDays(strMDOBMonth - 1) if strMDOBmonth = 2 and strMDOByear mod 4 = 0 and not (strMDOByear mod 100 = 0 and not strMDOBYear mod 400 = 0) then intDays = intDays + 1 end if if strMDOBday > intDays or strMDOB > left(DateToStr(strForumTimeAdjust), 8) then Err_Msg = Err_Msg & "
  • Date of Birth: Invalid Date
  • " else strMAge = DisplayUsersAge(DOBToDate(strMDOB)) end if end if end if if len(strMAge) > 0 then if not isNumeric(strMAge) then Err_Msg = Err_Msg & "
  • You must enter a numerical value for your age.
  • " elseif strMinAge > 0 and strMAge < strMinAge then Err_Msg = Err_Msg & "
  • You must be at least " & strMinAge & " years old to join this forum.
  • " end if 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 UserIPAddress = Request.ServerVariables("HTTP_X_FORWARDED_FOR") if UserIPAddress = "" then UserIPAddress = Request.ServerVariables("REMOTE_ADDR") 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 & ", " & cLng(Request.Form("ReceiveEMail")) & " " strSql = strSql & ", '" & UserIPAddress & "'" strSql = strSql & ", '" & UserIPAddress & "'" 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 & ", '" & strMAge & "'" else strSql = strsql & ", ''" end if if strAgeDOB = "1" then strSql = strsql & ", '" & strMDOB & "'" 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 'ss/**************************************** here I am going to wirte my insert query code for site registration through forum **************************************/ dim conn dim cst_hws dim UserConn 'open database connection to be used on page cst_hws = Application("constring") 'response.write(cst) set conn = CreateObject("ADODB.Connection") conn.open cst_hws 'dim ThisCategory 'dim SQLGetFirstCat, RSGetFirstCat ' SQLGetFirstCat = "SELECT CustomerID FROM Customers " ' set RSGetFirstCat=conn.execute(SQLGetFirstCat) ' ThisCategory = RSGetFirstCat("CustomerID") Dim SQLAddAccount, RSAddAccount_hws, ErrID, ErrText, AddFields, AddValues AddFields = AddFields & "SName," AddValues = AddValues & "'" & Request.Form("LastName") & "', " AddFields = AddFields & "FName," AddValues = AddValues & "'" & Request.Form("FirstName") & "', " AddFields = AddFields & "Password," AddValues = AddValues & "'" & Request.Form("Password") & "', " AddFields = AddFields & "EMail," AddValues = AddValues & "'" & Request.Form("Email") & "'" AddFields = AddFields & "Username," AddValues = AddValues & ",'" & Request.Form("Name") & "'" AddFields = AddFields & "Phone" AddValues = AddValues & ",''" AddFields = AddFields & ", Address1" AddValues = AddValues & ",''" AddFields = AddFields & ", Address2" AddValues = AddValues & ",''" AddFields = AddFields & ", Town" AddValues = AddValues & ",''" AddFields = AddFields & ", County" AddValues = AddValues & ",''" AddFields = AddFields & ", Postcode" AddValues = AddValues & ",''" AddFields = AddFields & ", Country" AddValues = AddValues & ",'" & Request.Form("Country") & "'" AddFields = AddFields & ", EMailingList" AddValues = AddValues & ",1" AddFields = AddFields & ", MailingList" AddValues = AddValues & ",1" dim jj, PasswordKey, SQLGetCustomerID, RSGetCustomerID randomize for jj=1 to 12 PasswordKey = PasswordKey & chr(int(rnd()*24+66)) next SQLAddAccount = "INSERT INTO Customers (" & AddFields & ",PasswordKey) VALUES (" & AddValues & ",'" & PasswordKey & "')" 'response.Write(SQLAddAccount) set RSAddAccount_hws = Conn.execute(SQLAddAccount) '/****************************************End of insert query code for site registration through forum ************************************************************/ if(session("URMode")="userMap") then response.Redirect("googlemaps4_hws_forum.asp") end if 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 = strForumTitle & " Registration " strMessage = "Hello " & Request.Form("name") & vbNewline & vbNewline strMessage = strMessage & "You received this message from " & strForumTitle & " because you have registered for a new account which allows you to post new messages and reply to existing ones on the forums at " & strForumURL & vbNewline & vbNewline if strAuthType="db" then '################################### E-mail Validation Mod ################################# if strEmailVal = "1" then strMessage = strMessage & "Please click on the link below to complete your registration." & vbNewline & vbNewLine strMessage = strMessage & "If the link is split or broken, you will need to copy and paste the entire link into your web browser." & vbNewline & vbNewLine strMessage = strMessage & strForumURL & "register.asp?actkey=" & actkey & vbNewline & vbNewline else '###################################################################################### strMessage = strMessage & "Password: " & Request.Form("Password") & vbNewline & vbNewline end if '<---- E-mail Validation Mod - 1 line ############# end if strMessage = strMessage & "You can change your information at our website by selecting the ""Profile"" link." & vbNewline & vbNewline strMessage = strMessage & "Happy Posting!" %> <% end if else Response.Write "

    There Was A Problem With Your Details

    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
      " & Err_Msg & "
    " & vbNewLine & _ "

    Go Back To Enter Data

    " & vbNewLine WriteFooter %>


     

     

    ::Ad Center::

    paypal


    We Buy & Sell, Books, Prints & photographs, Rare, Old & Unique, at mumfordbooks.co.uk
    UK's leading Family Bookstore with Quick Easy Ordering.
    Books and Images, for the Whole Family, an online Catalogue for Collectors
    NEW web site under construction seascape-guides.co.uk


    Discover your Welsh Roots and UK’s Heritage
    Walking and Cycling Maps with your own interactive Area Routes,
    making it easier and more enjoyable for people to walk, and to promote the benefits of walking.
    landscape-guides.co.uk

     

    We hope that you enjoy your visit to landscape-guides - why not add this site to your Favourites so
    that you can easily check for our latest additions!



    All of our checkout pages and any page on our site that asks for personal information from our customers is protected by SSL encryption.

    SSL
    catalogue
    SSL Secured

    <% response.write "

    " if Session("BasketItems") > 0 then response.write "" response.write "
    " response.write "
    full basket" & Session("BasketItems") & " items
    View basket
    " else response.write "" response.write "
    empty basketYour
    Shopping
    Basket is
    ready
    " end if %>

    Login here

    Purchase Online
    Quick Downloads
    Light Watermarks

     

    Selections from our Stock

    <% Dim SQLGetThumbList22, RSGetThumbList22, ThumbCount22 SQLGetThumbList22 = "SELECT distinct Books.BookID, Books.ThumbFile, Books.Title FROM Books " &_ "WHERE (((Books.Hide)=0) AND ((Books.HasThumb)=1) AND ((Books.Sold)=0));" set RSGetThumbList22 = server.createobject("ADODB.Recordset") RSGetThumbList22.open SQLGetThumbList22, connmain, 3, 3, 1 ThumbCount22 = RSGetThumbList22.RecordCount ' response.write ThumbCount1 & " books found" 'do until RSGetThumbList1.EOF Randomize Dim u for u=1 to 5 RSGetThumbList22.Move int(ThumbCount22*RND), 1 response.write "
    book
    " response.write server.htmlencode(RSGetThumbList22("Title")) response.write "

     

    " ' RSGetThumbList1.movenext next 'loop %>

    Home | Catalogue | Our Terms | Requests | Valuations | Feedback | Links | Search | Favourites

    Valid CSS!Valid HTML 4.01 Transitional


    1999-<%=year(date)%> Copyright Mike Mumford.


    Data Protection Act 1998 - Data Controller Name: MIKE MUMFORD Registration Number:Z63116776
    Telephone +44 (0)845 226 1769

    <% Response.End end if ' ##################### E-mail Validation Mod ######################### if lcase(strEmail) = "0" then Response.Write "


    Your Registration Has Been Completed!

    " & vbNewLine & _ "

    You may now begin posting" if strAuthType = "db" then Response.Write(" using your new UserName and Password") Response.Write ".

    " & vbNewLine else if strEmailVal = "1" then if(session("URMode")="userMap") then response.Redirect("googlemaps4_hws_forum.asp") end if Response.Write "


    Your Registration Is Almost Complete!

    " & vbNewLine '####################################### if strRestrictReg = "1" then Response.Write "

    The Administrator has restricted registration on this forum. You will receive an e-mail as soon as the Administrator approves your request.

    " & vbNewLine else Response.Write "

    Please follow the instructions in the e-mail that has been sent to " & ChkString(Request.Form("Email"),"email") & " to complete your registration.

    " & vbNewLine end if '####################################### else Response.Write "

    Your Registration Has Been Completed!

    " & vbNewLine & _ "

    You may now begin posting" if strAuthType = "db" then Response.Write(" using your new UserName and Password") 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 "

    Back To Forum

    " & vbNewLine end if else Response.Write "

    Sorry, we are not accepting any new Members at this time.

    " & vbNewLine & _ " " & vbNewLine & _ "

    Back To Forum


    " & vbNewLine end if WriteFooter %>


     

     

    ::Ad Center::

    paypal


    We Buy & Sell, Books, Prints & photographs, Rare, Old & Unique, at mumfordbooks.co.uk
    UK's leading Family Bookstore with Quick Easy Ordering.
    Books and Images, for the Whole Family, an online Catalogue for Collectors
    NEW web site under construction seascape-guides.co.uk


    Discover your Welsh Roots and UK’s Heritage
    Walking and Cycling Maps with your own interactive Area Routes,
    making it easier and more enjoyable for people to walk, and to promote the benefits of walking.
    landscape-guides.co.uk

     

    We hope that you enjoy your visit to landscape-guides - why not add this site to your Favourites so
    that you can easily check for our latest additions!



    All of our checkout pages and any page on our site that asks for personal information from our customers is protected by SSL encryption.

    SSL
    catalogue
    SSL Secured

    <% response.write "

    " if Session("BasketItems") > 0 then response.write "" response.write "
    " response.write "
    full basket" & Session("BasketItems") & " items
    View basket
    " else response.write "" response.write "
    empty basketYour
    Shopping
    Basket is
    ready
    " end if %>

    Login here

    Purchase Online
    Quick Downloads
    Light Watermarks

     

    Selections from our Stock

    <% Dim SQLGetThumbList25, RSGetThumbList25, ThumbCount25 SQLGetThumbList25 = "SELECT distinct Books.BookID, Books.ThumbFile, Books.Title FROM Books " &_ "WHERE (((Books.Hide)=0) AND ((Books.HasThumb)=1) AND ((Books.Sold)=0));" set RSGetThumbList25 = server.createobject("ADODB.Recordset") RSGetThumbList25.open SQLGetThumbList25, connmain, 3, 3, 1 ThumbCount25 = RSGetThumbList25.RecordCount ' response.write ThumbCount1 & " books found" 'do until RSGetThumbList1.EOF Randomize Dim v for v=1 to 5 RSGetThumbList25.Move int(ThumbCount25*RND), 1 response.write "
    book
    " response.write server.htmlencode(RSGetThumbList25("Title")) response.write "

     

    " ' RSGetThumbList1.movenext next 'loop %>

    Home | Catalogue | Our Terms | Requests | Valuations | Feedback | Links | Search | Login
    Add to Favourites | Tell a friend

    Valid CSS!Valid HTML 4.01 Transitional


    1999-<%=year(date)%> Copyright Mike Mumford.


    Follow Us


    Bookmark and Share

    Data Protection Act 1998 - Data Controller Name: MIKE MUMFORD Registration Number:Z63116776
    Telephone +44 (0)845 226 1769

    <% 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 & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
    " & vbNewLine Call DisplayProfileForm Response.Write "
    " & vbNewLine & _ "
    " & 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 = "
    • cannot contain any of the following characters: "" ; + ( ) * ' < > " 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 = "
    • cannot contain any spaces " 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 = "
    • must begin with either http:// or https:// " end if ' check to make sure URL is 255 characters or less if not bTemp then bTemp = len(sValidate) > 255 if bTemp then strURLError = "
    • cannot be more than 255 characters " end if ' no two consecutive dots if not bTemp then bTemp = InStr(sValidate, "..") > 0 if bTemp then strURLError = "
    • cannot contain consecutive periods " end if 'no spaces if not bTemp then bTemp = InStr(sValidate, " ") > 0 if bTemp then strURLError = "
    • cannot contain any spaces " end if if not bTemp then bTemp = (len(sValidate) <> len(Trim(sValidate))) if bTemp then strURLError = "
    • cannot contain any spaces " 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 & "
  • Username may not contain the word " & 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 " if strDBType = "mysql" then strSqlb = strSqlb & "ORDER BY LENGTH(B_BADWORD) DESC " else strSqlb = strSqlb & "ORDER BY LEN(B_BADWORD) DESC " end if 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 & "
  • Username may not contain the word " & bwords(i) & "
  • " exit function end if next end function %>