 |
|
|
|
|
|
|
|
|
|
|
|
Willkommen |
||||||||||
|
beim |
||||||||||
|
www.Flohmarkt-Reihersee.de |
||||||||||
|
21382 Brietlingen direkt an der B209 |
||||||||||
|
|
||||||||||
|
Termine 2024 Samstag 15.06.24 Samstag 22.06,24 Samstag 29.06.24 Samstag 13.07.24 Samstag 27.07.24 Samstag 03.08.24 Samstag 10.08.24 Samstag 24.08.24 Samstag 31.08.24 Samstag 07.09.24 Samstag 21.09.24 Samstag 28.09.24 Samstag 12.10.24 Samstag 19.10.24 Samstag 26.10.24 Samstag 09.11.24 Samstag 16.11.24 Samstag 30.11.24 mit Voranmeldung laufender Meter 8,- € Info Tel. 04133/3878 o. 01703835467 www.Flohmarkt-Reihersee.de
|
||||||||||
|
|
|
<%
' 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 & " ") comment = replace(comment, vbCr, " ") comment = replace(comment, """", """) If emoticons = true Then comment = replace(comment, ":)", " " & 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 & "" %> |
| [Flohmarkt Reihersee] [Termine] [Info] [Galerie] [Gästebuch] [Oldtimertreffen] [Hondatreffen] [Baden und Zelten] [Anfahrt] [Impressum] |