<%
'--------- Begin Update v2.0 ---------
' Entries are allowed once a day only (set in config.asp)
Dim alreadypostedtoday
If setacookie = True Then
If CBool(Request.Cookies("fipsgbookcookie")("today")) = TRUE then
alreadypostedtoday = TRUE
end if
end if
' Entries from one IP address are not allowed one after the other (set in config.asp)
Dim IPpostedbefore
If setIPblocker = True Then
Dim rsX, sqlX
sqlX = "SELECT TOP 1 * FROM gb ORDER BY ID DESC;"
Set rsX = Server.CreateObject("ADODB.RecordSet")
rsX.Open sqlX, Connect, 2, 3
If NOT rsX.EOF Then
If rsX("IPaddress") = Request.ServerVariables("REMOTE_ADDR") Then
IPpostedbefore = True
End If
End If
End If
%>
<% If alreadypostedtoday = TRUE then %>
<% elseif IPpostedbefore = TRUE then %>
<% else %>
<%
'--------- End Update v2.0 ---------
Function stripHTML(strHTML)
'Strips the HTML tags from strHTML
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<(.|\n)+?>"
'Replace all HTML tag matches with the empty string
strOutput = objRegExp.Replace(strHTML, "")
'Replace all < and > with nothing
strOutput = Replace(strOutput, "<", " ")
strOutput = Replace(strOutput, ">", " ")
stripHTML = strOutput 'Return the value of strOutput
Set objRegExp = Nothing
End Function
Function stripHTML2(strHTML2)
'Strips the HTML tags from strHTML
Dim objRegExp, strOutput2
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<(.|\n)+?>"
'Replace all HTML tag matches with the empty string
strOutput2 = objRegExp.Replace(strHTML2, "")
'Replace all < and > with < and >
strOutput2 = Replace(strOutput2, "<", "<")
strOutput2 = Replace(strOutput2, ">", ">")
stripHTML2 = strOutput2 'Return the value of strOutput
Set objRegExp = Nothing
End Function
' Now we take a look if this Entry has to be banned for some reason
Dim gbEntryBan
gbEntryBan = FALSE
Dim rsgbBan, sqlgbBan
sqlgbBan = "SELECT * FROM gb_ban ORDER BY banid ASC;"
Set rsgbBan = Server.CreateObject("ADODB.RecordSet")
rsgbBan.Open sqlgbBan, Connect, 2, 3
If NOT rsgbBan.EOF Then
do while not rsgbBan.EOF
If InStr(LCase(Request.Form("visName")), LCase(rsgbBan("bantxt"))) then
gbEntryBan = TRUE
ElseIf InStr(LCase(Request.Form("visEmail")), LCase(rsgbBan("bantxt"))) then
gbEntryBan = TRUE
ElseIf InStr(LCase(Request.Form("visHomepage")), LCase(rsgbBan("bantxt"))) then
gbEntryBan = TRUE
ElseIf InStr(LCase(Request.Form("visCity")), LCase(rsgbBan("bantxt"))) then
gbEntryBan = TRUE
ElseIf InStr(LCase(Request.Form("visCountry")), LCase(rsgbBan("bantxt"))) then
gbEntryBan = TRUE
ElseIf InStr(LCase(Request.Form("visEntry")), LCase(rsgbBan("bantxt"))) then
gbEntryBan = TRUE
ElseIf rsgbBan("bantxt") = Request.ServerVariables("REMOTE_ADDR") then
gbEntryBan = TRUE
End If
rsgbBan.MoveNext
Loop
end if
rsgbBan.Close
Set rsgbBan = Nothing
if gbEntryBan = TRUE then %>
<% else %>
<%
' Bad Words Filter
Private Function BadWords(ByVal strgbMessage)
Dim rsBadWordsFilter, sqlBadWordsFilter
Set rsBadWordsFilter = Server.CreateObject("ADODB.Recordset")
sqlBadWordsFilter = "SELECT * FROM gb_badwords;"
rsBadWordsFilter.Open sqlBadWordsFilter, Connect
Do While NOT rsBadWordsFilter.EOF
strgbMessage = Replace(strgbMessage, rsBadWordsFilter("badword"), rsBadWordsFilter("goodword"), 1, -1, 1)
rsBadWordsFilter.MoveNext
Loop
Set rsBadWordsFilter = Nothing
BadWords = strgbMessage
End Function
Dim formError, gbName, Email, City, Country, Homepage, Entry, IPaddress, formMode, X, str, vbCr
If Request.Form("send") <> "" Then
formError = ""
gbName = stripHTML(Request.Form("visName"))
Email = stripHTML(Request.Form("visEmail"))
City = stripHTML(Request.Form("City"))
Country = stripHTML(Request.Form("Country"))
Entry = stripHTML2(Request.Form("visEntry"))
Entry = Replace(Entry,str,str)
Entry = Replace(Entry,vbCr,vbCr)
Homepage = stripHTML(Request.Form("visHomepage"))
If Len(gbName) = 0 Then
formError = Lang_Error2
ElseIf validateEmail(Email) = False Then
formError = Lang_Error3
ElseIf Len(Entry) = 0 Then
formError = Lang_Error4
Elseif Len(Homepage) = 0 then
Homepage = "X"
End If
IPaddress = Request.ServerVariables("REMOTE_ADDR")
if IPaddress = "" then
IPaddress = "n/a"
else
IPaddress = Request.ServerVariables("REMOTE_ADDR")
end if
If Len(formError) = 0 or formError = "" Then
%>
<%
Const adOpenKeyset = 1
Const adLockOptimistic = 3
Set rs = Server.CreateObject("ADODB.RecordSet")
strSQL = "Select ID, Name, Email, City, Country, Homepage, Date, Entry, IPaddress, Comment From gb"
rs.Open strSQL, Connect, adOpenKeyset, adLockOptimistic
rs.AddNew
rs("Name") = BadWords(gbName)
rs("Email") = Email
rs("City") = City
rs("Country") = Country
rs("Homepage") = Homepage
rs("Date") = date()
rs("Entry") = BadWords(Entry)
rs("IPaddress") = IPaddress
rs.Update
rs.Close
Set rs = Nothing
Connect.Close
set Connect = Nothing
'--------- Begin Update v2.0 ---------
' Set a Cookie to disallow more entries than one a day
If setacookie = True Then
Response.Cookies("fipsgbookcookie")("today") = TRUE
Response.Cookies("fipsgbookcookie").Expires=Date()+1
end if
'--------- End Update v2.0 ---------
' Function for sending eMails / Funktion fuer das Senden der eMails
If SendaMail = True then
sendMailUser
sendMailOwner
Else
End If
' End Function / Ende der Funktion
' If everything is OK then / wenn alles in Ordnung ist, dann
' If you do not want to show the Thanks-page, redirect to guestbook
' Wenn Sie die Danke-Seite nicht anzeigen wollen, dann direkt zum Gaestebuch weiterschalten
%>
<%
'Else Thanks-page / Sonst Danke-Seite
ShowThanks
formMode = "OK"
%>
<%
' Else Show Error / Sonst Fehleranzeige
Else
formError = "
" & formError & ""
formMode = "error"
End If
End If
'Select FormMode / Auswahl Formular-Modus
'1. on Error / bei Fehlern
If formMode = "error" then
Response.Write "
" & Lang_Error1 & "
" & formError & "" & vbCrLf
Response.Write "" & vbCrLf
Response.Write "" & vbCrLf
'2. Form OK
elseif formMode = "OK" then
Response.write "" & Lang_BackLink & ""
'3. Normalanzeige
else
Response.Write "
" & vbCrLf
Response.Write "" & vbCrLf
Response.Write "" & vbCrLf
End If
End If
%>
<% end if %>
