<% '--- www.prilex.se ----------- '--- gastbok.asp ------------- '--- uppdaterad 2012-11-14 --- '--- © - Kenneth Ryding ------ Option Explicit Response.Buffer = "TRUE" 'Förklaring till de GLOBALA filerna som inkluderas nedan 'DBconnect.asp = Funktion för koppling till databasen 'Functions.inc = Diverse funktioner för stränghantering 'HTMLcontext.asp = Sidhuvud, Meny och Sidfot till layouten %> <% 'GLOBALA VARIABLER Dim strAction, strSQL, objRS, strFileName strAction = Server.UrlEncode(Request("action")) 'strAction styr programflödet i Main-rutinen strFileName = Request.ServerVariables("SCRIPT_NAME") 'strFileName ger namet på aktuell fil 'Variablerna nedan lagras med antingen formulär eller databas värden Dim strNamn, strEmail, strOrtStad, strKommentar, strDatum, strIPnummer, strOrd, RecSet 'Skriv ut Main-rutinen Main 'Skapa Main-rutinen och fyll den med olika programflöden Sub Main PrintHeader "GÄSTBOKEN" 'Global metod för att skriva ut sidhuvudet med titel som argument Select Case strAction Case "write" Write Case "DBinsert" DBinsert Case Else Read End Select fattas=fattas-30 PrintFooter End Sub %> <% 'SUB Write 'Skriv ut ett formulär 'Formuläret skickas sedan till Sub DBinsert Sub Write 'En funktion som slumpar ett säkerhetsord och sparar det i en session Dim arrLen, iArray(13) iArray(0) = "hatt" iArray(1) = "mobil" iArray(2) = "dator" iArray(3) = "bok" iArray(4) = "musik" iArray(5) = "saft" iArray(6) = "bulle" iArray(7) = "vatten" iArray(8) = "ros" iArray(9) = "bil" iArray(10) = "morot" iArray(11) = "glas" iArray(12) = "kaffe" iArray(13) = "gurka" arrLen = clng(UBound(iArray)) Randomize Session("rndWord")= iArray(Int((arrLen - 0 + 1) * Rnd + 0)) Response.Write _ "
" &_ "Läs i gästboken

" 'Skriv ut ett gästboks-formulär %>

Namn:    

E-post:   

Ort/Stad:

Kommentar:

Säkerhetsord: Eftersom vi inte gillar spam så krävs det att du besvarar en säkerhetsfrågan.

Skriv in ordet <%=Session("rndWord")%> baklänges:

<% End Sub %> <% 'SUB DBinsert 'validera formulär värden 'Sätt in formulär-värden i databasen alternativt skriv ut felmeddelande Sub DBinsert 'Samla formulär data och frisera dem! strNamn = FixaTecken(Request.form("namn")) strEmail = FixaTecken(Request.form("email")) strOrtStad = FixaTecken(Request.form("ortstad")) strKommentar = FixaTecken(Request.form("kommentar")) strOrd = FixaTecken(Request.form("ord")) strIPnummer = Request.ServerVariables("REMOTE_ADDR") If Len(strNamn) > 0 AND Len(strKommentar) > 0 AND Len(strOrd) > 1 AND strOrd = strReverse(Session("rndWord")) Then 'Om validering är godkänd sätt in värden i databasen strSQL = "SELECT * FROM gastbok" strSQL = "INSERT INTO gastbok(Namn,Email,OrtStad,Kommentar,IPnummer)VALUES('"& strNamn & "', '" & strEmail & "', '" & strOrtStad & "', '" & strKommentar & "', '" & strIPnummer & "')" dbConnect Connection Response.Write strSQL Connection.Execute(strSQL) Connection.Close Set Connection = Nothing '----skicka mail------------------- strJmailFrom = "gastboken@prilex.se" ' Avsändare (Email) strJmailFromName = "PRILEX Gästbok" ' Avsändare namn strJmailMottagare = "info@prilex.se" ' Mottagare (Email) strJmailMottagarex = "" ' Extra mottagare (Email) strJmailCC = "ordforande@prilex.se" ' CC Mottagare (Email) strJmailBCC = "" ' BCC Mottagare (Email) strJmailSubject = "PRILEX Gästbok" ' Ämne strJmailmsg = "" strJmailmsg = "PRILEX gästbok har uppdaterats !" & vbCrLf& vbCrLf strJmailmsg = strJmailmsg & "Från " & strNamn & vbCrLf strJmailmsg = strJmailmsg & "Inlägg " & strKommentar & vbCrLf strJmailmsg = strJmailmsg & "Ort / Stad " & strOrtStad & vbCrLf strJmailmsg = strJmailmsg & "E-post " & strEmail & vbCrLf strJmailmsg = strJmailmsg & "IP-nr " & strIPnummer & vbCrLf strJmailBody = strJmailmsg strJmailFelmsg = "" strJmailFelmsg = "Det blev ett fel när e-posten skulle skickas." strJmailSvarmsg = "" strJmailSvarmsg = strJmailSvarmsg & "Tack för ditt inlägg i gästboken."& "
" skicka_mail '----------------------------------- 'Skicka vidare användaren till gastbok.asp när DBinsättningen är klar Response.Redirect("gastbok.asp") Else 'Om valdieringen INTE är godkänd skriv då ut ett felmeddelande Response.Write "
Formuläret innehöll fel!
" 'Visa formuläret igen och spara tidigare inmatade värden %>

Namn:     <% If Len(strNamn) = 0 Then Response.Write "Namn är obligatoriskt" End If %>

E-post:   

Ort/Stad:

Kommentar: <% If Len(strKommentar) = 0 Then Response.Write "Kommentar är obligatoriskt" End If%>

Säkerhetsord: Eftersom vi inte gillar spam så krävs det att du besvarar en säkerhetsfrågan.

Skriv in ordet <%=Session("rndWord")%> baklänges: <% If Not strOrd=strReverse(Session("rndWord")) Then Response.Write "Fel säkerhetsord!" else Response.Write "Skriv igen!" End If %>

<% End If End Sub %> <% 'Sub Read 'Hämtar gästboksinlägg från databasen Sub Read Response.Write _ " " &_ "Skriv i gästboken

" &_ "Här nedan kan du läsa bland de inlägg som har gjorts i PRILEX gästbok." &_ "Om du vill skriva in dig i vår gästbok så kan klicka på länken skriv i gästboken ovan.
" &_ "
" Dim intPage, intPageSize, N, varArray, intTotalPages intPage = Request.QueryString("page") 'intpage är sidvärdet på det som står i QueryStringen If NOT IsNumeric(intPage) OR Len(intPage) = 0 Then intPage = 1 'kontrollera sidvärdet i QueryStringen intPageSize = 4 'bestäm hur många poster per sida som ska visas 'Gör hämtning i databasen av gästboksinläggen strSQL = "SELECT * FROM gastbok Order By Datum DESC" dbConnect Connection Set objRS = Server.CreateObject("ADODB.Recordset") objRS.PageSize = intPageSize objRS.Open strSQL, Connection, 1, 3 intTotalPages = objRS.PageCount If intPage - 1 >= intTotalPages Then intPage = 1 End If If Not objRS.EOF Then objRS.AbsolutePage = intPage varArray = objRS.GetRows(intPageSize) End If objRS.Close Set objRS = Nothing Connection.Close Set Connection = Nothing Response.Write "" If intTotalPages = 0 Then Response.Write "Visar sida " & intPage & " i gästboken.

" Else Response.Write "Visar sida " & intPage & " av " & intTotalPages & " i gästboken.

" End If Response.Write "" If IsArray(varArray) Then For N = 0 TO UBound(varArray,2) 'Ta emot värden från DB, lägg de i en Array 'Lägg arrayerna i dess olika strängar som sedan friseras strDatum = varArray(1,N) strNamn = HTMLtecken(varArray(2,N)) strEmail = HTMLtecken(varArray(3,N)) strOrtStad = HTMLtecken(varArray(4,N)) strKommentar = HTMLtecken(varArray(5,N)) strKommentar = URLify(strKommentar, "new_win") strKommentar = BR(strKommentar) strIPnummer = varArray(6,N) 'Skriv ut innehållet i en tabell Response.Write _ "" &_ "" &_ "" &_ "" &_ "" &_ "
" &_ "Från: " & strNamn & "
" &_ " " &_ "		" &_ "Datum: " & strDatum & "
" &_ "Ort/Stad: " & strOrtStad &_ "
" &_ "" &_ "" &_ "
" & strKommentar & "
" &_ "
" &_ "" Next End If 'Skriv ut sida för nästa och föregående Response.Write _ "" &_ "" &_ "" &_ "" &_ "" &_ "
" If CLng(intPage) > 1 Then Response.Write _ " " &_ "Föregående " Else Response.Write " " End If Response.Write _ "" If CLng(intPage) < CLng(intTotalPages) Then Response.Write _ "Nästa " &_ " " Else Response.Write " " End if Response.Write _ "
" End Sub %>