|
<%
' Guestbook settings
Const gbpath = "../guestbook/"
Const separateForm = false
Const topForm = true
Const notifywebmaster = false
Const notifyemail = ""
Const showtime = true
Const emoticons = true
Const smtpip = ""
' Constants for file opening
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
' Constants for fatal errors
Const errorCreateDatFile = 530
Const errorReadDatFile = 531
Const errorWriteDatFile = 532
'Stops execution on fatal error
'@param Code (int) Error code
Function raiseFatalError(ByVal Code)
Response.Write ""
Response.End
End Function
' Attempts to open the [@filename] file in [@iomode] mode
'
' @returns OnSuccess: TextStream object
' @returns OnFailure: Nothing
Function gbOpenFile( ByVal filename, ByVal iomode )
On Error Resume Next
' set default return value
Set gbOpenFile = Nothing
Dim fileSystem
Set fileSystem = CreateObject( "Scripting.FileSystemObject" )
If Not( fileSystem Is Nothing ) Then
If fileSystem.FileExists( filename ) Then
Set gbOpenFile = fileSystem.OpenTextFile( filename, iomode )
End If
Set fileSystem = Nothing
End If
End Function
' Attempts to create the [@filename] file
'
' @returns OnSuccess: TextStream object
' @returns OnFailure: Nothing
Function gbCreateFile( ByVal filename )
On Error Resume Next
' set default return value
Set gbCreateFile = Nothing
Dim fileSystem
Set fileSystem = CreateObject( "Scripting.FileSystemObject" )
If Not( fileSystem Is Nothing ) Then
Set gbCreateFile = fileSystem.CreateTextFile( filename, True )
Set fileSystem = Nothing
End If
End Function
'loads entries from the entries.dat file
Function loadEntries
Dim objFS, entries, textstream, f
' by default, entries are empty (contains only a newline character)
entries = vbCr
'read guestbook entries into textstream
Set objFS = Server.CreateObject( "Scripting.FileSystemObject" )
If objFS.FileExists( Server.MapPath( gbpath & "entries.dat" ) ) Then
Set textstream = gbOpenFile( Server.MapPath( gbpath & "entries.dat" ), ForReading )
If textstream Is Nothing Then
raiseFatalError errorReadDatFile
Else
entries = textstream.ReadAll
textstream.Close
End If
Else
Set f = gbCreateFile( Server.MapPath( gbpath & "entries.dat" ) )
If f Is Nothing Then
raiseFatalError errorCreateDatFile
response.End
Else
f.Write vbCr
f.Close
End If
End If
loadEntries = entries
End Function
'generates a comment string from the post-ed information to this page
Function generateComment
Dim name, email, homepage, city, country, comment, signed, state
'read data entered into form
name = CStr( Request.Form( "name" ) )
email = CStr( Request.Form( "email" ) )
homepage = CStr( Request.Form( "homepage" ) )
city = CStr( Request.Form( "city" ) )
country = CStr( Request.Form( "country" ) )
state = CStr( Request.Form( "state" ) )
comment = CStr( Request.Form( "comment" ) )
signed = FormatDateTime( Date, 1 ) & " " & Time
Dim full
full = "
" & vbCr
'print a comented line containing the fields (for editing purposes)
full = full & "" & vbCr
'print each field if entered
full = full & ""
If Not( name = "" ) Then
full = full & "Name: "
End If
If Not( email = "" ) Then
full = full & ""
End If
full = full & name
If Not( email = "" ) Then
full = full & ""
End If
full = full & "
"
If Not( homepage = "" ) Then
full = full & "Homepage: " & homepage & "
"
End If
If Not( city = "" ) Then
full = full & "Stadt: " & city & "
"
End If
If Not( state = "" ) Then
full = full & "Bundesland: " & state & "
"
End If
If Not( country = "" ) Then
full = full & "Land: " & country & "
"
End If
If showtime = true Then
full = full & "Gesendet: " & signed & "
"
End If
full = full & " "
comment = replace(comment, "<", "<")
comment = replace(comment, ">", ">")
comment = replace(comment, vbCrLf, "
")
comment = replace(comment, vbCr, "
")
comment = replace(comment, """", """)
If emoticons = true Then
comment = replace(comment, ":)", " ")
comment = replace(comment, ":D", "")
comment = replace(comment, "=))", "")
comment = replace(comment, ":/", "")
comment = replace(comment, ":(", "")
comment = replace(comment, "X(", "")
comment = replace(comment, ":P", "")
comment = replace(comment, ";)", "")
End If
full = full & "" & comment & " " & vbCr
generateComment = full
End Function
'adds a comment to the entries file
Sub addComment
Dim objFS, entries, textstream
entries = loadEntries
On error resume next
Dim newComment
newComment = generateComment
Set textstream = gbOpenFile( Server.MapPath(gbpath & "entries.dat" ), ForWriting )
If textstream Is Nothing Then
raiseFatalError errorWriteDatFile
Else
textstream.Write newComment
textstream.Write entries
textstream.Close
End If
'Notify the webmaster
If notifywebmaster = true Then
Dim objCfg, objMail
Dim strBody
strBody = "Hallo, es wurde ein neuer Eintrag in Ihrem Gästebuch vorgenommen." & vbCrLf & vbCrLf
strBody = strBody & "Name: " & CStr(Request.Form("name")) & vbCrLf & "Kommentar: " & CStr(Request.Form("comment"))
Set objMail = Server.CreateObject("CDO.Message")
Set objCfg = Server.CreateObject("CDO.Configuration")
'Out going SMTP server
if smtpip <> "" then
objCfg.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpip
end if
objCfg.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objCfg.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objCfg.Fields.Update
Set objMail.configuration = objCfg
objMail.From = "guestbook"
objMail.To = notifyemail
objMail.Subject = "Neuer Gästebucheintrag"
objMail.HtmlBody = strBody
Err.Clear
objMail.send
Set objMail = Nothing
Set objCfg = Nothing
End If
End Sub
'entry point
Dim op
op = Request.queryString( "op" )
If (op = "add") Then
addComment
'reload this page
Response.Redirect Request.ServerVariables( "URL" )
End If
Dim entries
entries = loadEntries
%>
Gästebuch
<% If separateForm Then %>
Kommentar hinzufügen
<% End If %>
<%
entries = replace( entries, "$PATH", gbpath )
Response.Write entries & "
"
%>
|
