<% ' option explicit %> <% ' Response.Buffer = true %> <% Dim dbc Dim strConn 'strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("/pages/guestbook.mdb")& ";Persist Security Info=False" strConn = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("/pages/guestbook.mdb") Set dbc = Server.CreateObject("ADODB.Connection") dbc.mode = 3 dbc.open strConn Function Lineify(strInput) Dim strTemp strTemp = Server.HTMLEncode(strInput) strTemp = Replace(strTemp, " ", "       ", 1, -1, 1) strTemp = Replace(strTemp, " ", "      ", 1, -1, 1) strTemp = Replace(strTemp, " ", "     ", 1, -1, 1) strTemp = Replace(strTemp, " ", "    ", 1, -1, 1) strTemp = Replace(strTemp, " ", "   ", 1, -1, 1) strTemp = Replace(strTemp, vbTab, "     ", 1, -1, 1) strTemp = Replace(strTemp, vbCrLf, "
" & vbCrLf, 1, -1, 1) Lineify = strTemp End Function function GetServerVariables() For Each Item in Request.ServerVariables For iCount = 1 to Request.ServerVariables(Item).Count ge = ge & Item & " = " & Request.ServerVariables(Item)(iCount) & "
" Next Next GetServerVariables = ge end function function EstUnSpam(text) if instr(text," "" then .To = pour end if if copie <> "" Then .CC = copie End if if cacher <> "" Then .BCC = cacher End if .From = de .sender = de .ReplyTo = de .Subject = sujet .HTMLBody = txt if attache <> "" Then .addattachment server.mappath(attache) End if .Send End With if err.number <> 0 then Response.Write err.Description & "
" Else ' response.write "envoyé" end if Set Fields = Nothing Set objMessage = Nothing Set objConfig = Nothing end function function AddNL(nom, mail) Set RsVerif= CreateObject("adodb.recordset") strSQL = "Select * from NewsLetters WHERE Mail = '" & mail & "'" RsVerif.Open strSQL, dbc1, adOpenStatic If RsVerif.EOF Then Set rsc = Server.CreateObject ("ADODB.Recordset") rsc.Open "NewsLetters", dbc1, adOpenStatic, adLockPessimistic rsc.AddNew rsc("Nom") = nom rsc("Mail") = mail rsc.Update rsc.Close dbc1.Close Set dbc1 = nothing End if End function ' /////////////////////////////////////////////////////////////////////////// ' // configuration. ' how many entries are being displayed on one page. ' normally you would specify here something between 20 and 50. const HITS_PER_PAGE = 30 ' string resources, used by other parts of the page. ' used in order to separate code from content. '-todo: add more. const IDS_ANONYMOUS = "Anonymous" const IDS_FIELDSMISSING = "Tous les champs demandés n'ont pas étés remplis. Le message n'est pas enregistré." const IDS_ERRORDELETE = "Error deleting entry." const IDS_MAIL = "Send e-mail to" const IDS_ERROR = "Error occured." ' /////////////////////////////////////////////////////////////////////////// ' // global constants/variables. ' there is a global mode for the guestbook. ' depending on that mode, this page behaves different. ' you therefore don't need different pages do to things like ' e.g. inserting or deleting. ' supported modes. const MODE_NORMAL = 1 ' normal viewing of the guestbook. const MODE_ERROR = 2 ' an error occured and is displayed. const MODE_INSERT = 4 ' inserting of a item into the guestbook. const MODE_DELETE = 8 ' deleting of an item of the guestbook. const MODE_ADMIN = 16 ' administration-mode: allows deletion of articles. ' read mode. default to normal. dim mode mode = Request("mode") if mode="" then mode = MODE_NORMAL mode = CLng(mode) ' /////////////////////////////////////////////////////////////////////////// ' // general helper functions. ' minimum and maximum functions. function min( a, b ) if ab then max=a else max=b end function ' formats a date. function fmtDate( in_str ) fmtDate = FormatDateTime( in_str, 2 ) end function ' replaces '\n' with '
' function fmtMl( in_str ) if IsNull(in_str) then fmtMl = "" exit function end if dim str if in_str<>"" then str = Replace( in_str, vbCrLf, vbCr ) str = Replace( str , vbLf , vbCr ) str = Replace( str , vbCr , "
" ) fmtMl = str else fmtMl = in_str end if end function ' allow several html codes, but not all! function fmtText( byval txt ) ' first encode all. txt = Server.HtmlEncode(txt) ' then decode the allowed tags. txt = Replace( txt, Server.HtmlEncode(""), "" ) txt = Replace( txt, Server.HtmlEncode(""), "" ) txt = Replace( txt, Server.HtmlEncode(""), "" ) txt = Replace( txt, Server.HtmlEncode(""), "" ) txt = Replace( txt, Server.HtmlEncode(""), "" ) txt = Replace( txt, Server.HtmlEncode(""), "" ) txt = Replace( txt, Server.HtmlEncode(""), "" ) txt = Replace( txt, Server.HtmlEncode(""), "" ) fmtText = fmtMl(txt) end function ' /////////////////////////////////////////////////////////////////////////// ' // url functions. ' these functions should be used whenever you need a
' tag. instead of specifying an asp page and adding some cryptic ' parameters, you call one of these functions. ' with this approach, you can centralize the url-parameters ' in one place. ' the url of this page. ' automatically adds admin mode if currently active. function myselfUrl( mode_ ) if (CLng(mode) and CLng(MODE_ADMIN))<>CLng(0) then mode_ = CLng(mode_) or CLng(MODE_ADMIN) end if myselfUrl = Request.ServerVariables("SCRIPT_NAME") & "?mode=" & mode_ end function ' url for viewing the guestbook in normal mode. function normalUrl normalUrl = myselfUrl(MODE_NORMAL) end function ' url for displaying an error. function errorUrl( error_text ) errorUrl = myselfUrl(MODE_ERROR) & "&error=" & Server.UrlEncode(error_text) end function ' url for inserting a new entry to the guestbook. function insertUrl insertUrl = myselfUrl(MODE_INSERT) end function ' url for deleting an entry from the guestbook. function deleteUrl( id ) 'deleteUrl = "/pages/livre.html?delete=1&id=" & Server.UrlEncode(id) deleteUrl = myselfUrl(MODE_DELETE) & "&id=" & Server.UrlEncode(id) end function function naviUrl( page ) naviUrl = myselfUrl(MODE_NORMAL) & "&pg=" & page end function ' /////////////////////////////////////////////////////////////////////////// ' // special helper functions. ' creates a connection to the database. function openDb() 'set openDb = Server.CreateObject("ADODB.Connection") 'openDb.mode = adModeReadWrite 'openDb.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & _ ' "DBQ=" &Server.MapPath("/pages/guestbook.mdb") openDb = dbc end function ' insert a new entry to the guestbook. ' returns true when successfull, false when failed. function insertEntry( byref conn ) dim name dim email dim text if (request("insert") = "true" AND cok() = false) or EstUnSpam(Request("gb_text")) = "True" Then insertEntry = false else ' read parameters. name = Request.form("gb_name") email = Request.form("gb_email") text = Request.form("gb_text") ' AddNL name, email ' check parameters. if name="" then name = IDS_ANONYMOUS if text="" then insertEntry = false exit function end if ' open recordset. dim rs set rs = Server.CreateObject("ADODB.Recordset") rs.Open "Guestbook", conn, 2, 3 ' create new recordset. rs.AddNew rs("Date") = Now rs("Name") = name if email <> "" then rs("EMail") = email else rs("EMail") = null email ="anonyme@charlotte.ch" end if rs("Text") = text rs.Update txt = Lineify(text) &"

" & GetServerVariables() envmail "info@webinside.ch", "", "", eMail, "CharlotteParfois.ch - Nouvelle entrée Livre", txt ' succeeded. insertEntry = true end if end function ' delete an entry from the guestbook. ' returns true when successfull, false when failed. function deleteEntry( byref conn ) ' read parameters. dim id id = Request("id") ' check parameters. if id="" then deleteEntry = false exit function end if on error resume next Set RsVerif= CreateObject("adodb.recordset") strSQL = "DELETE FROM Guestbook WHERE nref=" & id RsVerif.Open strSQL, dbc, adOpenStatic 'dbc.Execute "DELETE FROM Guestbook WHERE nref=" &id if err<>0 then deleteEntry = false else deleteEntry = true end if end function ' check, whether a mode is currently active. function hasMode( mode_chk ) if (CLng(mode) and CLng(mode_chk))<>0 then hasMode = true else hasMode = false end if end function ' /////////////////////////////////////////////////////////////////////////// ' // "main function" and html code. ' open the db. dim conn conn = dbc ' *************************************************************************** ' new entry. if hasMode(MODE_INSERT) then ' when a new entry is posted, insert it. if not insertEntry(conn) then Response.Redirect errorUrl(IDS_FIELDSMISSING) else ' Response.Redirect normalUrl end if end if ' *************************************************************************** ' delete entry. if request("delete") = "1" Then Set RsVerif= CreateObject("adodb.recordset") strSQL = "DELETE FROM Guestbook WHERE nref=" & request("id") RsVerif.Open strSQL, dbc, adOpenStatic End if if hasMode(MODE_DELETE) then ' when an entry needs to be delete, do it. if not deleteEntry(conn) then Response.Redirect errorUrl(IDS_ERRORDELETE& " : " &err.Description) else Response.Redirect normalUrl end if end if ' *************************************************************************** ' count the total number of entries. dim rs set rs = dbc.Execute("SELECT COUNT(*) FROM Guestbook") dim sum_cnt sum_cnt = rs(0) ' *************************************************************************** ' calculate: pages, start, end, etc. dim cur_page if Request("pg")="" then cur_page = 0 else cur_page = Request("pg") end if dim total_pages total_pages = CLng(CLng(sum_cnt)/CLng(HITS_PER_PAGE)) if (CLng(CLng(sum_cnt) mod CLng(HITS_PER_PAGE))>0) and _ (CLng(sum_cnt)>CLng(HITS_PER_PAGE)) then total_pages = total_pages+1 end if if total_pages<=0 then total_pages=1 ' the # of the displayed hits. dim hit_display_start, hit_display_end hit_display_start = 1+cur_page*HITS_PER_PAGE hit_display_end = hit_display_start+min(CLng(sum_cnt),CLng(HITS_PER_PAGE))-1 if hit_display_end>sum_cnt then hit_display_end=sum_cnt ' --------------------------------- ' the numbers must be displayed descending. dim cntdwn_start dim cntdwn_end cntdwn_start = sum_cnt-hit_display_start+1 cntdwn_end = sum_cnt-hit_display_end+1 ' *************************************************************************** ' navigation flags. ' whether there exists a previous or a next page. dim can_prev_page, can_next_page, can_prevornext_page if CLng(cur_page)>0 then can_prev_page=true else can_prev_page=false end if if CLng(cur_page)< CLng(total_pages)-1 then can_next_page=true else can_next_page=false end if can_prevornext_page = can_prev_page or can_next_page ' --------------------------------- ' whether there exists a first and a last page. dim can_first_page, can_last_page can_first_page = (can_prevornext_page) and (cur_page>0) can_last_page = (can_prevornext_page) and (CLng(cur_page)<(CLng(total_pages)-1)) ' *************************************************************************** ' query entries. set rs = dbc.Execute("SELECT * FROM Guestbook ORDER BY Date DESC") ' navigate to start-recordset. if not (rs.Bof and rs.Eof) then rs.Move hit_display_start-1 end if ' end of the pure asp-part. ' /////////////////////////////////////////////////////////////////////////// %>


Dans cette rubrique, tu peux laisser tes états d'âme, raconter des histoires et éventuellement dire des bêtises .

<% if hasMode(MODE_ERROR) then %>

<%=IDS_ERROR &" : "& Request("error")%>

<% end if %>

Crée ton message toi-même tout seul


<% ' *************************************************************************** ' output all entries. dim cntdwn cntdwn = cntdwn_start dim cnt cnt = 0 while not rs.Eof and CLng(cnt)
<%=cntdwn%>.  <%if e then%> " href="mailto:<%=ASCIICode(rs("EMail"))%>"> <%end if%> <%=rs("Name")%> <%if e then%> <%end if%> , <%=fmtDate(rs("Date"))%> <%if hasMode(MODE_ADMIN) then%>  " class="courant">Delete entry <%end if%>

<%=fmtText(rs("Text"))%>

<% cntdwn = cntdwn-1 rs.MoveNext wend %>

D'ici, tu peux écrire à Charlotte.

Nom et prénom :
30<%Else%>20<%end if%>">
E-Mail :
30<%Else%>20<%end if%>">
et le texte de sa race que tu fais toi-même avec tes petites mains potelées et ton cerveau qui fume:

Anti-spam : <% setcok()%>

 


<% ' /////////////////////////////////////////////////////////////////////////// %>