<% function preCheck(daCheckString) if len(daCheckString) > 0 then preCheck = replace(replace(replace(replace(replace(daCheckString,Chr(38),"&",1),Chr(34),""",1),Chr(145),""",1),Chr(180),""",1),Chr(39),""",1) else preCheck = "" end if end function function reCheck(daCheckString) if len(daCheckString) > 0 then reCheck = replace(replace(replace(replace(replace(daCheckString,"&",Chr(38),1),""",Chr(34),1),""",Chr(145),1),""",Chr(180),1),""",Chr(39),1) else reCheck = "" end if end function connString = "Provider=SQLOLEDB.1;User ID=sa;PASSWORD=qt3xbbsncsn8;Initial Catalog=obone_de;Data Source=62.217.63.8;Persist Security Info=True;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=DG-GL-SPC-003;Use Encryption for Data=False;Tag with column collation when possible=False;" if len(request.queryString("gbID")) > 0 then gbID = request.queryString("gbid") Session("gbID") = gbID Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="SELECT * FROM GaestebuchSetup WHERE ID = " & gbID rsRS.open sqlString, rsConn, 0, 1, 1 rsSetup = rsRS.GetRows curCols= ubound(rsSetup,1) curRows= ubound(rsSetup,2) Set rsRS = Nothing Set rsConn = Nothing else Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="SELECT * FROM GaestebuchSetup WHERE Server_Name like '%" & request.ServerVariables("SERVER_NAME") & "'" rsRS.open sqlString, rsConn, 0, 1, 1 if not rsRS.EOF then rsSetup = rsRS.GetRows curCols= ubound(rsSetup,1) curRows= ubound(rsSetup,2) Set rsRS = Nothing Set rsConn = Nothing if curRows > 0 then ' ---- Hier muss dann später die Auswählmöglichkeit des richtigen Gästebuchs hin!!! ---- response.redirect "http://www.obone.de/" response.end ' -------------------------------------------------------------------------------------- else Session("gbID") = rsSetup(0,0) gbID = Session("gbID") end if else ' ---- Hier muss dann später die Admin-Seite hin!!! ---- response.redirect "http://www.obone.de/" response.end ' ------------------------------------------------------ end if end if Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="SELECT * FROM GaestebuchStatistik WHERE URL = '" & request.ServerVariables("SERVER_NAME") & "' AND gbID = " & gbID rsRS.open sqlString, rsConn, 0, 1, 1 if not rsRS.EOF then if NOT Session("alreadyWritten") then sqlString = "UPDATE GaestebuchStatistik SET Hits = (Hits + 1), Views = (Views + 1), LastView = '" & now() & "' WHERE URL = '" & request.ServerVariables("SERVER_NAME") & "' AND gbID = " & gbID else sqlString = "UPDATE GaestebuchStatistik SET Views = (Views + 1), LastView = '" & now() & "' WHERE URL = '" & request.ServerVariables("SERVER_NAME") & "' AND gbID = " & gbID end if Session("alreadyWritten") = true rsRs.Close rsRS.open sqlString, rsConn, 0, 1, 1 Set rsRS = Nothing Set rsConn = Nothing else sqlString = "INSERT INTO GaestebuchStatistik (URL, gbID, Hits, Views, LastView) VALUES ('" & request.ServerVariables("SERVER_NAME") & "', " & gbID & ", 1, 1, '" & now() & "')" Session("alreadyWritten") = true rsRs.Close rsRS.open sqlString, rsConn, 0, 1, 1 Set rsRS = Nothing Set rsConn = Nothing end if '-------- HEADER -------- curHeader = "" & vbcrlf curHeader = curHeader & "" & vbcrlf curHeader = curHeader & "[Gästebuch] http://gaestebuch.obone.de/" & vbcrlf curHeader = curHeader & "" & vbcrlf curHeader = curHeader & "" & vbcrlf curHeader = curHeader & "" & vbcrlf curHeader = curHeader & "" & vbcrlf curHeader = curHeader & "" & vbcrlf curHeader = curHeader & "" & vbcrlf '-------- BODY ---------- curBody = "" & vbcrlf '------------------------ if instr(1,request.querystring,"admin") > 0 AND NOT Session("admin") then if instr(1,request.querystring,"adminvalidate") > 0 then Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="SELECT * FROM GaestebuchSetup WHERE Name = '" & request.form("name") & "' AND Password = '" & request.form("password") & "'" rsRS.open sqlString, rsConn, 0, 1, 1 if not rsRS.EOF then rsArr = rsRS.GetRows curCols= ubound(rsArr,1) curRows= ubound(rsArr,2) Set rsRS = Nothing Set rsConn = Nothing Session("admin") = true Session("gbAdminID") = rsArr(0,0) 'response.write Session("gbAdminID") & "
" else curContent = "
" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "
Anmeldung nicht möglich (falscher Benutzername oder Kennwort)
Name
Passwort
" & vbcrlf curContent = curContent & "
" response.write curHeader & curBody & curContent & "" response.end end if else curContent = "
" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "
 
Anmeldung
 
 Name  
 Passwort  
 

 
" & vbcrlf curContent = curContent & "
" response.write curHeader & curBody & curContent & "" response.end end if end if if len(request.QueryString("action")) > 0 then daPage = request.QueryString("action") else daPage = "show" end if Select Case daPage Case "insert" errorCount = 0 if len(request.form("insert")) > 0 then if len(request.form("user")) < 3 then errorCount = errorCount + 1 if len(request.form("email")) < 7 OR instr(1,request.form("email"),"@") < 1 OR instr(1,request.form("email"),".") < 2 then errorCount = errorCount + 1 if len(request.form("message")) < 2 then errorCount = errorCount + 1 end if if len(request.form("insert")) > 0 AND errorCount < 1 then Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="INSERT INTO Gaestebuch (gbID, Name, Email, Homepage, YahooMessenger, AIM, MSNMessenger, ICQ, EntryDate, Message, Comment) VALUES (" & gbID & ", '" & request.form("user") & "', '" & request.form("email") & "', '" & request.form("url") & "', '" & request.form("yahoo") & "', '" & request.form("aim") & "', '" & request.form("msn") & "', '" & request.form("icq") & "', '" & now() & "', '" & preCheck(request.form("message")) & "', '')" rsRS.open sqlString, rsConn, 0, 1, 1 set rsRs = nothing set rsConn = nothing response.redirect "./default.htm?gbid=" & gbID & "&action=show&entry=last#last" response.end else curContent = "
 
" & vbcrlf curContent = curContent & "" & vbcrlf else curContent = curContent & "Name:" & vbcrlf end if curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf else curContent = curContent & "EMail:" & vbcrlf end if curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf else curContent = curContent & "Eintrag:" & vbcrlf end if curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "
Eintragen
" if len(request.form("insert")) > 0 AND len(request.form("user")) < 3 then curContent = curContent & "Name =>
" if len(request.form("insert")) > 0 AND (len(request.form("email")) < 7 OR instr(1,request.form("email"),"@") < 1 OR instr(1,request.form("email"),".") < 2) then curContent = curContent & "EMail =>
URL:
Yahoo:
MSN:
ICQ:
AIM:
" if len(request.form("insert")) > 0 AND len(request.form("message")) < 2 then curContent = curContent & "Eintrag =>
 " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "" & vbcrlf end if Case "change" if len(request.form("insert")) > 0 then curContent = "
 
" & vbcrlf Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="UPDATE Gaestebuch SET Message = '" & preCheck(request.form("message")) & "', Comment = '" & preCheck(request.form("comment")) & "' WHERE ID = " & request.queryString("recordid") & " AND gbID = " & Session("gbAdminID") rsRS.open sqlString, rsConn, 0, 1, 1 set rsRs = nothing set rsConn = nothing else curContent = "
Änderungen wurden gespeichert!
 
" & vbcrlf end if Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="SELECT * FROM Gaestebuch WHERE ID = " & request.queryString("recordid") rsRS.open sqlString, rsConn, 0, 1, 1 if not rsRS.EOF then rsArr = rsRS.GetRows curCols= ubound(rsArr,1) curRows= ubound(rsArr,2) Set rsRS = Nothing Set rsConn = Nothing daMessage = reCheck(rsArr(9,0)) daComment = reCheck(rsArr(10,0)) Set rsArr = nothing else Set rsRS = Nothing Set rsConn = Nothing response.redirect "./default.htm?gbID=" & gbID & "&page=" & request.queryString("page") response.end end if curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "
Änderung eines Eintrags
" curContent = curContent & "Eintrag:
" curContent = curContent & "Kommentar:
 " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "" & vbcrlf Case "delete" if Session("admin") AND CStr(gbID) = CStr(Session("gbAdminID")) then curContent = "
" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "" & vbcrlf curContent = curContent & "
Sind Sie sicher, dass der Eintrag dauerhaft gelöscht werden soll?

" & vbcrlf curContent = curContent & "JA        NEIN
" & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "
" else response.redirect "./default.htm?gbid=" & gbID & "&page=" & request.querystring("page") response.end end if Case "delconf" if Session("admin") AND CStr(gbID) = CStr(Session("gbAdminID")) AND len(request.querystring("recordid")) > 0 then Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="DELETE FROM Gaestebuch WHERE gbID = " & Session("gbAdminID") & " AND ID = " & request.querystring("recordid") rsRS.open sqlString, rsConn, 0, 1, 1 set rsRS = nothing set rsConn = nothing end if response.redirect "./default.htm?gbid=" & gbID & "&page=" & request.querystring("page") response.end Case else curNumDisplay = (rsSetup(6,0) - 1) if len(request.queryString("gbid")) > 0 OR len(gbID) > 0 OR len(Session("gbID")) > 0 then if len(request.QueryString("page")) > 0 then curPage = request.QueryString("page") else curPage = 1 end if if len(request.queryString("gbid")) > 0 then gbID = request.queryString("gbid") elseif len(gbID) > 0 then gbID = gbID elseif len(Session("gbID")) > 0 then gbID = Session("gbID") else response.redirect "http://gaestebuch.obone.de/" response.end end if Set rsConn = Server.CreateObject("ADODB.Connection") Set rsRS = Server.CreateObject("ADODB.Recordset") rsConn.Open connString sqlString="SELECT * FROM Gaestebuch WHERE gbID = " & gbID & " ORDER BY EntryDate DESC" rsRS.open sqlString, rsConn, 0, 1, 1 if not rsRS.EOF then rsArr = rsRS.GetRows curCols= ubound(rsArr,1) curRows= ubound(rsArr,2) Set rsRS = Nothing Set rsConn = Nothing lastPage = ((curRows + 1) \ (curNumDisplay + 1)) + 1 if len(request.QueryString("entry")) > 0 then if lastPage > 1 then curFrom = curRows - curNumDisplay curTo = curRows else curFrom = 0 curTo = curRows end if else if curRows => curPage * curNumDisplay then curFrom = (curPage - 1) * curNumDisplay curTo = curPage * curNumDisplay else if curRows => ((curPage - 1) * curNumDisplay) then curFrom = (curPage - 1) * curNumDisplay curTo = curRows else curFrom = curRows - curNumDisplay curTo = curRows end if end if end if curContent = "" & vbcrlf curContent = curContent & "" & vbcrlf if Session("admin") AND CStr(gbID) = CStr(Session("gbAdminID")) then curContent = curContent & " " & vbcrlf end if curContent = curContent & "" & vbcrlf for curRow = curFrom to curTo 'response.write curRow & "
" curContent = curContent & "" & vbcrlf 'response.write gbID & "=" & Session("gbAdminID") & "
" if Session("admin") AND CStr(gbID) = CStr(Session("gbAdminID")) then curContent = curContent & " " & vbcrlf end if curContent = curContent & "" & vbcrlf next curContent = curContent & "
" if len(rsSetup(12,0)) > 0 then curContent = curContent & "" & vbcrlf if len(rsSetup(14,0)) > 0 then curContent = curContent & "" & vbcrlf if len(rsSetup(13,0)) > 0 then curContent = curContent & "" & vbcrlf curContent = curContent & "
" & rsSetup(12,0) & "
" & rsSetup(13,0) & "
" & vbcrlf curContent = curContent & "" & vbcrlf if CInt(gbID) = 1002 then response.write "lastPage: " & lastPage & "
curPage: " & curPage & "
curRows + 1: " & (curRows + 1) & "
CurNumDisplay: " & curNumDisplay & "
(curRows + 1) \ curNumDisplay: " & ((curRows + 1) \ curNumDisplay) & "

" end if if curPage > 1 then curContent = curContent & "<< " else curContent = curContent & "<< " end if curContent = curContent & "" if CInt(lastPage) > CInt(curPage) then curContent = curContent & " >>" else curContent = curContent & " >>" end if curContent = curContent & "" & vbcrlf curContent = curContent & "
Eintrag hinzufügen ]
globale Einstellungen ändern ]
 
" & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & "
" & vbcrlf if len(request.queryString("entry")) > 0 then curContent = curContent & " " & rsArr(1,curRow) & "" & vbcrlf else curContent = curContent & " " & rsArr(1,curRow) & "" & vbcrlf end if curContent = curContent & " " & vbcrlf curContent = curContent & " " & rsArr(8,curRow) & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "
" & vbcrlf if len(rsArr(2,curRow)) > 0 then curContent = curContent & " " & vbcrlf if len(rsArr(3,curRow)) > 0 then curContent = curContent & " " & vbcrlf if len(rsArr(4,curRow)) > 0 then curContent = curContent & " " & vbcrlf if len(rsArr(7,curRow)) > 0 then curContent = curContent & " " & vbcrlf if len(rsArr(6,curRow)) > 0 then curContent = curContent & " " & vbcrlf if len(rsArr(5,curRow)) > 0 then curContent = curContent & " " & vbcrlf curContent = curContent & "

" & vbcrlf curContent = curContent & "
" & vbcrlf if rsSetup(11,0) > 0 then if len(rsArr(9,curRow)) > 0 then curContent = curContent & replace(rsArr(9,curRow),vbcrlf,"
") & vbcrlf if len(rsArr(10,curRow)) > 0 then curContent = curContent & "
KOMMENTAR:
" & replace(rsArr(10,curRow),vbcrlf,"
") & vbcrlf else if len(rsArr(9,curRow)) > 0 then curContent = curContent & replace(replace(replace(rsArr(9,curRow),"<","<",1),">",">",1),vbcrlf,"
") & vbcrlf if len(rsArr(10,curRow)) > 0 then curContent = curContent & "
KOMMENTAR:
" & replace(replace(replace(rsArr(10,curRow),"<","<",1),">",">",1),vbcrlf,"
") & vbcrlf end if curContent = curContent & "
 " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "
LÖSCHEN ]    [ ÄNDERN ]
 
" else curContent = "" & vbcrlf for curRow = 0 to curRows curContent = curContent & "" & vbcrlf next curContent = curContent & "
" & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & " ADMINISTRATOR" & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & " " & now() & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & " " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & " Ihr Gästebuch ist eingerichtet!
Dieser Beitrag verschwindet automatisch sobald der erste echte Eintrag erstellt wurde. Sie sollten nun einen ersten begrüßenden Eintrag für die Besucher Ihres Gästebuchs hinterlassen:
 
[ Eintrag hinzufügen ]" & vbcrlf curContent = curContent & "
 " & vbcrlf curContent = curContent & "
" & vbcrlf curContent = curContent & "
" end if else response.redirect "http://www.obone.de/" response.end end if end select response.write curHeader & curBody & curContent response.end %>