<% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Guestbook '** '** Copyright 2001-2004 Bruce Corkhill All Rights Reserved. '** '** This program is free software; you can modify (at your own risk) any part of it '** under the terms of the License that accompanies this software and use it both '** privately and commercially. '** '** All copyright notices must remain in tacked in the scripts and the '** outputted HTML. '** '** You may use parts of this program in your own private work, but you may NOT '** redistribute, repackage, or sell the whole or any part of this program even '** if it is modified or reverse engineered in whole or in part without express '** permission from the author. '** '** You may not pass the whole or any part of this application off as your own work. '** '** All links to Web Wiz Guide and powered by logo's must remain unchanged and in place '** and must remain visible when the pages are viewed unless permission is first granted '** by the copyright holder. '** '** This program is distributed in the hope that it will be useful, '** but WITHOUT ANY WARRANTY; without even the implied warranty of '** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER '** WARRANTIES WHETHER EXPRESSED OR IMPLIED. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.com '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Set the response buffer to true as we maybe redirecting Response.Buffer = True 'Dimension variables Dim strInputName 'Holds the Users name Dim strInputCountry 'Holds the users country Dim strInputEmailAddress 'Holds the Users e-mail address Dim strInputHomepage 'Holds the Users homepage Dim strInputComments 'Holds the Users comments Dim saryCommentWord 'Array to hold each word in the comments enetred by the user Dim intCheckWordLengthLoopCounter 'Loop counter Dim intWordLength 'Holds the length of the word to be checked Dim blnWordLenthOK 'Boolean set to False if any words in the description are above 30 characters Dim intLongestWordLength 'Holds the number of characters in the longest word entered in the description Dim strEmailSubject 'Holds the subject of the e-mail notification Dim strEmailBody 'Holds the body of the e-mail Dim blnEmailSent 'Set to tru if the e-mail is sent Dim blnAlreadyPostsed 'Set to true if the person has already posted comments in the gb Dim intLoop 'Loop counter Dim blnSessionID 'Set to true if the session ID is OK Dim blnSecurityCodeOK 'Intialise variables blnAlreadyPostsed = False blnSessionID = False blnSecurityCodeOK = true 'Read in user deatils from the guestbook form strInputName = Trim(Mid(Request.Form("name"), 1, 30)) strInputCountry = Trim(Mid(Request.Form("country"), 1, 40)) strInputEmailAddress = Trim(Mid(Request.Form("email"), 1, 50)) strInputHomepage = Trim(Mid(Request.Form("homepage"), 1, 50)) strInputComments = Trim(Request.Form("comments")) 'Strip HTML tags strInputName = Replace(strInputName, "<", "<", 1, -1, 1) strInputName = Replace(strInputName, ">", ">", 1, -1, 1) strInputComments = Replace(strInputComments, "<", "<", 1, -1, 1) strInputComments = Replace(strInputComments, ">", ">", 1, -1, 1) If strInputCountry = "0" Then strInputCountry = "None Given" 'Strip malicious code from the homepage and email links strInputEmailAddress = characterStrip(LCase(strInputEmailAddress)) strInputHomepage = characterStrip(LCase(strInputHomepage)) 'Check to see if the session ID's match then don't save If blnSessionCheck Then If Request.Form("sid") = HashEncode(Session.SessionID) Then blnSessionID = True Else blnSessionID = True End If 'Check security code is OK If blnSecurityImages AND (Session("lngSecurityCode") <> Trim(Mid(Request.Form("securityCode"), 1, 6))) Then 'Set the security code OK variable to false blnSecurityCodeOK = False End If 'Split-up each word in the comments from the user to check that no word entered is over 50 characters saryCommentWord = Split(Trim(strInputComments), " ") 'Initialse the word length variable blnWordLenthOK = True 'Loop round to check that each word in the comments entered by the user is not above 50 characters For intCheckWordLengthLoopCounter = 0 To UBound(saryCommentWord) 'Initialise the intWordLength variable with the length of the word to be searched intWordLength = Len(saryCommentWord(intCheckWordLengthLoopCounter)) 'Get the number of characters in the longest word If intWordLength => intLongestWordLength Then intLongestWordLength = intWordLength 'If the word length to be searched is more than or equal to 50 then set the blnWordLegthOK to false If intWordLength => 50 Then blnWordLenthOK = False Next 'Change my own codes for bold and italic HTML tags back to the normal satndrd HTML tags now that the check for unwated HTML tags is over strInputComments = Replace(strInputComments, "[B]", "", 1, -1, 1) strInputComments = Replace(strInputComments, "[/B]", "", 1, -1, 1) strInputComments = Replace(strInputComments, "[I]", "", 1, -1, 1) strInputComments = Replace(strInputComments, "[/I]", "", 1, -1, 1) strInputComments = Replace(strInputComments, "[U]", "", 1, -1, 1) strInputComments = Replace(strInputComments, "[/U]", "", 1, -1, 1) 'Loop through the emoticons array and change codes to emoticons For intLoop = 1 to UBound(saryEmoticons) strInputComments = Replace(strInputComments, saryEmoticons(intLoop,2), "", 1, -1, 1) Next 'Replace the vb new line code for the HTML new break code strInputComments = Replace(strInputComments, vbCrLf, "
") 'Get rid of repeated return key hits so there arn't two many new lines going half way down the page (
is the HTML tag for new line) 'Loop though the comments entered by the user till all cases of two new lines togather are replaced by one new line Do While InStr(1, strInputComments, "

" ,vbTextCompare) > 0 'Replace

with one case of
strInputComments = Replace(strInputComments , "

", "
") Loop 'Replace swear words with other words with *** 'Initalise the SQL string with a query to read in all the words from the smut table strSQL = "SELECT " & strDbTable & "Smut.* FROM " & strDbTable & "Smut;" 'Open the recordset rsCommon.Open strSQL, adoCon 'Loop through all the words to check for Do While NOT rsCommon.EOF 'Replace the swear words with the words in the database the swear words strInputComments = Replace(strInputComments, rsCommon("Smut"), rsCommon("Word_replace"), 1, -1, 1) strInputName = Replace(strInputName, rsCommon("Smut"), rsCommon("Word_replace"), 1, -1, 1) strInputCountry = Replace(strInputCountry, rsCommon("Smut"), rsCommon("Word_replace"), 1, -1, 1) strInputHomepage = Replace(strInputHomepage, rsCommon("Smut"), rsCommon("Word_replace"), 1, -1, 1) 'Move to the next word in the recordset rsCommon.MoveNext Loop 'Reset recordset rsCommon.Close 'Initalise the SQL string with a query to read in all the comments from the database strSQL = "SELECT TOP 1 " & strDbTable & "Comments.* FROM " & strDbTable & "Comments ORDER BY " & strDbTable & "Comments.MessageID DESC;" '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 recordset rsCommon.Open strSQL, adoCon 'If cookies anti spam settings are enabled check a cookie has not already been set If blnCookieSet = True Then If CBool(Request.Cookies("WWGBook")("Signed")) = True Then blnAlreadyPostsed = True End If 'If IP blooking ant-spam settings are enabled check the IP address of the last poster If blnIPBlocking = True Then If NOT rsCommon.EOF Then If rsCommon("IP") = Request.ServerVariables("REMOTE_ADDR") Then blnAlreadyPostsed = True End If End If 'If there is no comments then display an error message If strInputComments = "" AND strInputName = "" Then blnAlreadyPostsed = True 'Write to the database if there are no unwanted HTML tags or the word lengths in the commets entered by the user are OK If blnWordLenthOK AND blnSessionID AND blnAlreadyPostsed = False AND blnSecurityCodeOK Then 'Add a new record to the recordset rsCommon.AddNew rsCommon.Fields("Name") = strInputName rsCommon.Fields("Country") = strInputCountry rsCommon.Fields("EMail") = strInputEmailAddress rsCommon.Fields("Homepage") = strInputHomepage rsCommon.Fields("Comments") = strInputComments rsCommon.Fields("IP") = Request.ServerVariables("REMOTE_ADDR") 'If the comments need to be authirsed first don't display them If blnAuthorise Then rsCommon.Fields("Authorised") = false Else rsCommon.Fields("Authorised") = true End If 'Update the database with the new recordset rsCommon.Update 'Requery the database to make sure that the new comments have been added 'This will make the script wait until Database has updated itself as sometimes Access can be a little slow at updating rsCommon.Requery 'If cookies anti-spam settings are enabled set a cookie on the users machine If blnCookieSet = True Then Response.Cookies("WWGBook")("Signed") = True Response.Cookies("WWGBook").Expires = DateAdd("n", 30, Now()) End If 'If the guestbook is configured to send an e-mail then send one If blnEmail = True Then 'Turn the smiley image paths back into text :) strInputComments = Replace(strInputComments, "", ":)", 1, -1, 1) strInputComments = Replace(strInputComments, "", ";)", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":o", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":D", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":errr:", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":(", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":x", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":o)", 1, -1, 1) strInputComments = Replace(strInputComments, "", "[:oops:]", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":X:", 1, -1, 1) strInputComments = Replace(strInputComments, "", "xx(", 1, -1, 1) strInputComments = Replace(strInputComments, "", "|)", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":V:", 1, -1, 1) strInputComments = Replace(strInputComments, "", ":^:", 1, -1, 1) strInputComments = Replace(strInputComments, "", "}:)", 1, -1, 1) strInputComments = Replace(strInputComments, "", "8D", 1, -1, 1) 'Initilise the subject of the e-mail strEmailSubject = "Guestbook comment notification" 'Initailise the e-mail body variable with the body of the e-mail strEmailBody = "Hi " strEmailBody = strEmailBody & "

This e-mail is automactically generated by the Guestbook on your web site." strEmailBody = strEmailBody & "
The following comment has been posted in the Guestbook: -" strEmailBody = strEmailBody & "

Name: " & strInputName strEmailBody = strEmailBody & "
E-Mail: " & strInputEmailAddress strEmailBody = strEmailBody & "
Country: " & strInputCountry strEmailBody = strEmailBody & "
Homepage: " & strInputHomepage strEmailBody = strEmailBody & "
Comments: -
" & strInputComments 'Call the funtion to send the e-mail blnEmailSent = SendMail(strEmailBody, strWebSiteEmailAddress, strEmailSubject, strMailComponent) End If 'Return to the guestbook If blnAuthorise = false Then 'Reset Server Variables rsCommon.Close Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing Response.Redirect "default.asp?PagePosition=1" End If End If 'Reset Server Variables rsCommon.Close Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing %> Sign the Guest Book
Sign the Guestbook
" target="_self"> Return to the the Guestbook
<% 'If the session ID's don't match make sure the user has cookies enabled If blnSessionID = False Then %> An authentication error occurred.
Please ensure that cookies are enabled on your browser.
<% 'Else If the security code is incorrect let the use know ElseIf blnSecurityCodeOK = False Then %> A security error occurred.
Please ensure that the security code entered matches that displayed.

Re-enter my comments
<% 'If word length is to long display an error message ElseIf blnAlreadyPostsed Then %> Our records show that you have already posted comments in the Guestbook
<% 'If authrisation of posts is enabled let the user know that there post will need to be authorised first ElseIf blnAuthorise Then %> Your comments have been saved.

Your comments will need to be approved by the Guestbook administrator before they are displayed to others visiting the site.
<% 'If the user has already posted display an error message Else %> Sorry, one or more of the words used in your Comments where to long

Edit my comments
<% End If %>



<% '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** If blnLCode = True Then Response.Write("Powered by Web Wiz Guestbook version " & strVersion & "") Response.Write("
Copyright ©2001-2004 Web Wiz Guide") End If '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** %>