<%@ Language=VBScript %> <% Option Explicit %> <% Response.Expires=0 %> <% '///////////////////////////////////////////////////// ' Guestbook database ' format parameters '///////////////////////////////////////////////////// dim gb_db dim gb_colorHead, gb_colorMessage, gb_fontText, gb_fontEnd, gb_fontTool, gb_fontHead dim gb_pageSeparator,gb_pageSeparatorLong gb_pageSeparator=" " gb_pageSeparatorLong=" ... " gb_colorHead="660000" gb_colorMessage="FFFFEE" gb_fontHead="" gb_fontText="" gb_fontTool="" gb_fontEnd="" sub gb_SendMail(strFrom,strTo,strSubject,strBody) ' Uses CDONTS.NewMail object to send mail dim mail set mail=Server.CreateObject("CDONTS.NewMail") mail.From=strFrom mail.To=strTo mail.Subject=strSubject mail.Body=strBody mail.Send set mail=nothing end sub dim gb_aMonth(12) gb_aMonth(1)="Jan" gb_aMonth(2)="Fev" gb_aMonth(3)="Mar" gb_aMonth(4)="Abr" gb_aMonth(5)="Mai" gb_aMonth(6)="Jun" gb_aMonth(7)="Jul" gb_aMonth(8)="Ago" gb_aMonth(9)="Set" gb_aMonth(10)="Out" gb_aMonth(11)="Nov" gb_aMonth(12)="Dez" function gb_show_datetime(dt) ' show date and time dim s, sm s=day(dt) & "/" & gb_aMonth(month(dt)) & "/" & year(dt) & " " sm=":" & minute(dt) if len(sm)=2 then sm=":0" & minute(dt) sm=hour(dt) & sm if len(sm)=4 then sm="0" & sm s=s & "
" & sm gb_show_datetime=s end function function gb_encode_html(str) ' like Server.HTMLEncode(...) str=str & " " str=replace(str,"&","&") str=replace(str,"<","<") str=replace(str,">",">") str=replace(str,"""",""") gb_encode_html=str end function function gb_SQLDATE(d) ' make "#year/month/day#" from date dim strYear,strMonth,strDay strYear = CStr(Year(d)) strMonth = CStr(Month(d)) if Month(d) < 10 then strMonth = "0" & strMonth end if strDay = CStr(Day(d)) if Day(d) < 10 then strDay = "0" & strDay end if SQLDATE="#" & strYear & "/" & strMonth & "/" & strDay & "#" end function function gb_doCode(str, oTag, cTag, roTag, rcTag) ' replace guestbook codes dim i,cnt,p,tmp,tmp1,url dim tx,t tx = split(str, cTag) t = "" for i = 0 to ubound(tx) if lcase(oTag) = "[a]" then p = instr(1, tx(i), "[a]", 1) if p <> 0 then tmp = mid(tx(i), p) url = mid(tmp, 4) if instr(1,url,":")>0 then tmp1 = Replace(tmp, "[a]"&url, "" & gb_fontText & url & gb_fontEnd & "", 1, -1, 1) else tmp1 = Replace(tmp, "[a]"&url, "" & gb_fontText & url & gb_fontEnd & "", 1, -1, 1) end if t =t & Replace(tx(i), tmp, tmp1) else t = t & tx(i) end if else cnt = instr(1,tx(i), oTag,1) select case cnt case 0 t=t&tx(i) & " " case else t = t & Replace(tx(i), oTag, roTag,1,1,1) 't = t & " " & rcTag & " " t = t & rcTag end select end if next gb_doCode = t end function Function gb_smile(s) ' replace smiles dim rsIcons if s > "" then set rsIcons=gb_db.Execute("SELECT * FROM icons") while not rsIcons.EOF dim strIcon strIcon="" s = replace(s, rsIcons("icon_code"), strIcon) rsIcons.MoveNext wend rsIcons.Close set rsIcons=nothing gb_smile = s else gb_smile = "" end if End function Function gb_chkString(str) if str = "" then gb_chkString="" exit function End If dim rsAdmin set rsAdmin=gb_db.Execute("SELECT * FROM admin") if rsAdmin("allow_codes") then str = gb_doCode(str, "[a]", "[/a]", "", "") str = gb_doCode(str, "[b]", "[/b]", "", "") str = gb_doCode(str, "[i]", "[/i]", "", "") str = gb_doCode(str, "[c]", "[/c]", "", "") str = gb_doCode(str, "[code]", "[/code]", "

", "

") end if if rsAdmin("allow_icons") then str=gb_smile(str) end if rsAdmin.Close set rsAdmin=nothing ' Replace CR & LF with
str = Replace(str, vbCrLf,"
") str = Replace(str, vbCr,"
") str = Replace(str, vbLf,"
") gb_chkString = str End Function sub gb_Write(byref s,s1) s=s+gb_fontText & s1 & gb_fontEnd end sub sub gb_Write1(byref s,s1) s=s+gb_fontHead & s1 & gb_fontEnd end sub sub gb_Write2(byref s,s1) s=s+gb_fontTool & s1 & gb_fontEnd end sub function gb_GetUrl dim url url="http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL") gb_GetUrl=url end function function gb_redirectToView(bUsePage) dim url url=gb_GetUrl if bUsePage And Request.QueryString("page")<>"" then url=url & "?page=" & Request.QueryString("page") Response.Redirect(url) Response.Flush Response.End end function Function gb_removeRecord gb_db.Execute("DELETE * FROM gb WHERE id=" & Request.QueryString("id")) gb_redirectToView true gb_removeRecord="" end Function Function gb_editRecord dim s s="" dim r set r=gb_db.Execute("SELECT * FROM gb WHERE id=" & Request.QueryString("id")) if not r.EOF then s=s & "" end if r.Close set r=nothing gb_editRecord=s end Function Function gb_addRecord dim s s="" s=s & "" gb_addRecord=s end Function Function gb_submitRecord(bSendNotify,strEmail) if len(Request.Form("name"))=0 then gb_submitRecord="

Erro: Campo 'Nome' deve ser preenchido

" elseif len(Request.Form("email"))=0 then gb_submitRecord="

Erro: Campo 'Email' deve ser preenchido

" elseif len(Request.Form("text"))=0 then gb_submitRecord="

Erro: Campo 'Mensagem' deve ser preenchido

" elseif len(Request.Form("text"))>512 then gb_submitRecord="

Erro: Campo 'Mensagem' deve ter no máximo 512 caracteres

" elseif instr(1,Request.Form("text"),"http")>0 or instr(1,Request.Form("to"),"http")>0 or instr(1,Request.Form("name"),"http")>0 then gb_submitRecord="

Obrigado

" else dim r set r=Server.CreateObject("ADODB.RecordSet") On Error Resume Next r.Open "SELECT * FROM gb",gb_db,,3 if err.number <> 0 then Response.Redirect "http://www.espirito.org.br/" end if r.AddNew r("date1")=now() r("name")=mid(Request.Form("name"),1,50) r("to")=mid(Request.Form("to"),1,50) r("email")=mid(Request.Form("email"),1,100) r("text1")=mid(Request.Form("text"),1,4096) if bSendNotify then dim strBody strBody=gb_show_datetime(r("date1")) & vbCrLf strBody=strBody & r("name") & "(" & r("email") & ") de: " & r("to") & vbCrLf strBody=strBody & r("text1") gb_SendMail "nobody@nowhere",strEmail,"GuestBook notification",strBody end if r.Update() r.Close set r=nothing gb_redirectToView false gb_submitRecord="" end if end Function Function gb_updateRecord dim r set r=Server.CreateObject("ADODB.RecordSet") On Error Resume Next r.Open "SELECT * FROM gb WHERE id=" & Request.QueryString("id"),gb_db,,3 if err.number <> 0 then Response.Redirect "http://www.espirito.org.br/" end if r("name")=mid(Request.Form("name"),1,50) r("to")=mid(Request.Form("to"),1,50) r("email")=mid(Request.Form("email"),1,100) r("text1")=mid(Request.Form("text"),1,4096) r("resp")=mid(Request.Form("resp"),1,4096) r.Update() r.Close set r=nothing gb_redirectToView true gb_updateRecord="" end Function Function gb_invokeHelp(bAllowCodes,bAllowIcons) dim s s="" s=s & "" gb_Write2 s,"Ver o Livro de Visitas * Assinar o Livro de Visitas" & gb_fontEnd s=s & "

" if bAllowCodes then gb_Write s,"Códigos para o Livro de Visitas" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "

" gb_Write2 s,"Format commands:" s=s & "
" gb_Write1 s,"Format" s=s & "	" gb_Write1 s,"Description" s=s & "
" gb_Write s,"[a]url[/a]" s=s & "	" gb_Write s,"Insert a hyperlink" s=s & "
" gb_Write s,"[b]text[/b]" s=s & "	" gb_Write s,"Format text as bold" s=s & "
" gb_Write s,"[i]text[/i]" s=s & "	" gb_Write s,"Format text as italic" s=s & "
" gb_Write s,"[code]text[/code]" s=s & "	" gb_Write s,"Format text as code (<pre> tag)" s=s & "

" end if if bAllowIcons then s=s & "" s=s & "" s=s & "" s=s & "" dim rsIcons set rsIcons=gb_db.Execute("SELECT * FROM icons") while not rsIcons.EOF dim strIcon strIcon="" s=s & "" s=s & "" rsIcons.MoveNext wend rsIcons.Close set rsIcons=nothing s=s & "

" gb_Write2 s,"Emoticons:" s=s & "
" gb_Write1 s,"Ícone" s=s & "	" gb_Write1 s,"Código" s=s & "	" gb_Write1 s,"Descrição" s=s & "
" s=s & strIcon s=s & "	" gb_Write s,rsIcons("icon_code") s=s & "	" gb_Write s,rsIcons("icon_description") s=s & "

" end if if not bAllowCodes and not bAllowIcons then s=s & "" gb_Write2 s,"Guestbook codes and smiles are disabled" s=s & "" end if gb_invokeHelp=s end Function sub gb_pageNav(s,page,current_page) if current_page=page then s=s & "" & page & "" else s=s & "" & page & "" end if end sub sub show_paging(s,max_page,page) if max_page>1 then s=s & "" & gb_fontTool & "Páginas: " dim i if max_page<=10 then for i=1 to max_page gb_pageNav s,i,page if i=max_page-5 then gb_pageNav s,1,page s=s & gb_pageSeparatorLong for i=max_page-8 to max_page gb_pageNav s,i,page if i" end if end sub Function gb_viewAll(bAdmin,nPageSize) dim s s=s & "" s=s & "" dim r set r=Server.CreateObject("ADODB.Recordset") ' count records On Error Resume Next r.Open "SELECT count(id) as r_c FROM gb",gb_db if err.number <> 0 then Response.Redirect "http://www.espirito.org.br/" end if dim TotalRecords TotalRecords=r("r_c") r.Close dim max_page,page max_page=TotalRecords\nPageSize if TotalRecords mod nPageSize>0 then max_page=max_page+1 page=CLng(Request.QueryString("page")) if page<1 then page=1 if page>max_page then page=max_page end if s=s & "" dim first_record first_record=(page-1)*nPageSize On Error Resume Next r.Open "SELECT * FROM gb ORDER BY date1 DESC,id DESC",gb_db if err.number <> 0 then Response.Redirect "http://www.espirito.org.br/" end if while first_record>0 and not r.EOF r.MoveNext first_record=first_record-1 wend if r.EOF then s=s & "" end if while not r.EOF and nPageSize>0 nPageSize=nPageSize-1 s=s & "" s=s & "" s=s & "" s=s & "" ' Message s=s & "" s=s & "" ' Response dim s_resp s_resp=r("resp") if Len(s_resp)>0 then s=s & "" s=s & "" s=s & "" s=s & "" end if ' End of record s=s & "" s=s & "" r.MoveNext wend s=s & "

" gb_Write2 s,"[ Assinar o Livro de Visitas ]" & gb_fontEnd s=s & "

" show_paging s,max_page,page s=s & "

" gb_Write1 s,"Nenhum registro encontrado." s=s & "

" gb_Write1 s,gb_show_datetime(r("date1")) s=s & "

" 's=s & "" 's=s & "" 'if r("email")<>"" then ' s=s & "" 'end if 's=s & "
" gb_Write1 s,gb_encode_html(r("name")) 's=s & "
" ' gb_Write1 s,r("email") ' s=s & "" ' s=s & "
" s=s & "

" if len(r("to"))>0 then gb_Write1 s, gb_encode_html(r("to")) else ' gb_Write1 s,"To: All" gb_Write1 s," " end if s=s & "

" dim s_text1 s_text1=r("text1") 's=s & "Tam:[" & len(s_text1) & "]" if Len(s_text1)>0 then 'gb_Write s,gb_chkString(gb_encode_html(r("text1"))) gb_Write s,gb_chkString(gb_encode_html(s_text1)) else gb_Write s, "Nenhum comentário" end if s=s & "

" gb_Write1 s,"Resposta do Portal do Espírito:" s=s & "

" gb_Write s,gb_chkString(gb_encode_html(s_resp)) s=s & "

" s=s & gb_fontTool if bAdmin then s=s & "*" s=s & "del" s=s & "*" s=s & "edit" s=s & "*" else s=s & " " end if s=s & gb_fontEnd s=s & "

" r.Close set r=nothing show_paging s,max_page,page gb_viewAll=s end Function function gb_adminPage(bAdmin) dim s s="" s=s & "" gb_Write2 s,"Ver o Livro de Visitas * Assinar o Livro de Visitas" & gb_fontEnd s=s & "

" s=s & "

" s=s & "" if bAdmin then dim rsAdmin set rsAdmin=gb_db.Execute("SELECT * FROM admin") s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "" s=s & "

" gb_Write2 s,"New password:" s=s & "	" s=s & "" s=s & "
" gb_Write2 s,"Allow codes:" s=s & "	" if rsAdmin("allow_codes") then s=s & "" else s=s & "" end if s=s & "
" gb_Write2 s,"Allow icons:" s=s & "	" if rsAdmin("allow_icons") then s=s & "" else s=s & "" end if s=s & "
" gb_Write2 s,"Records per page:" s=s & "	" s=s & "" s=s & "
" gb_Write2 s,"Send notify:" s=s & "	" if rsAdmin("send_notify") then s=s & "" else s=s & "" end if s=s & "
" gb_Write2 s,"Notify email:" s=s & "	" s=s & "" s=s & "
" s=s & "" rsAdmin.Close set rsAdmin=nothing else s=s & "
" gb_Write2 s,"Password:" s=s & "	" s=s & "" s=s & "
" s=s & "" end if s=s & "

" s=s & "

" gb_adminPage=s end function '////////////////////////////////////////////////////// ' Main guestbook routine. Returns whole html coded ' guestbook as a result. ' Parameters: ' src = guestbook database connection string '////////////////////////////////////////////////////// function gb_init(src) 'on error resume next dim action action=Request.QueryString("action") set gb_db= Server.CreateObject("ADODB.Connection") On Error Resume Next gb_db.Open(src) if err.number <> 0 then Response.Redirect "http://www.espirito.org.br/" end if dim r set r=Server.CreateObject("ADODB.RecordSet") ' begin processing dim bAdmin dim nMaxRecords ' store password in session object if Request.Form("password")<>"" then Session("password")=Request.Form("password") action="admin" end if bAdmin=false ' Check admin rights & change password On Error Resume Next r.Open "SELECT * FROM admin",gb_db,,3 ' only one record in this table if err.number <> 0 then Response.Redirect "http://www.espirito.org.br/" end if if Session("password")=r("password") then bAdmin=true ' check password if action="admin" and bAdmin then dim bUpdate bUpdate=false if Request.Form("new_password")<>"" then ' change admin password r("password")=Request.Form("new_password") Session("password")=Request.Form("new_password") bUpdate=true end if if Request.Form("allow_codes")<>"" then r("allow_codes")=Request.Form("allow_codes") bUpdate=true end if if Request.Form("allow_icons")<>"" then r("allow_icons")=Request.Form("allow_icons") bUpdate=true end if if Request.Form("page_size")<>"" then r("page_size")=Request.Form("page_size") bUpdate=true end if if Request.Form("send_notify")<>"" then r("send_notify")=Request.Form("send_notify") bUpdate=true end if if Request.Form("email")<>"" then r("email")=Request.Form("email") bUpdate=true end if if bUpdate then r.Update() end if end if ' Load maximum records per page value nMaxRecords=r("page_size") ' process action select case action case "remove" if bAdmin then gb_init=gb_removeRecord else gb_init=gb_viewAll(bAdmin,nMaxRecords) end if case "edit" if bAdmin then gb_init=gb_editRecord else gb_init=gb_viewAll(bAdmin,nMaxRecords) end if case "sign" gb_init=gb_addRecord case "submit" gb_init=gb_submitRecord(r("send_notify"),r("email")) case "admin" gb_init=gb_adminPage(bAdmin) case "update" if bAdmin then gb_init=gb_updateRecord else gb_init=gb_viewAll(bAdmin,nMaxRecords) end if case "help" gb_init=gb_invokeHelp(r("allow_codes"),r("allow_icons")) case else gb_init=gb_viewAll(bAdmin,nMaxRecords) end select ' Close admin recordset r.Close ' cleanup and exit set r=nothing gb_db.Close() set gb_db=nothing end function '-------------------------------------------------------------------------------------------- dim gb_text dim connection_string ' Setup connection 'connection_string="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("database/gbdb.mdb") & ";" 'connection_string="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=c:\Program Files\Ensim\Site Data\espirito\inetpub\ftproot\databases\visitas.mdb;" if left(Request.ServerVariables("APPL_PHYSICAL_PATH"),6) = "D:\web" then connection_string="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=D:\web\brnt3sp269\databases\visitas.mdb;" else 'connection_string="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=c:\Program Files\Ensim\SiteData\webppliance\conf\domains\espirito\Inetpub\ftproot\databases\visitas.mdb;" 'connection_string="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=c:\domains\espirito.org.br\db\visitas.mdb;" connection_string="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=C:\inetpub\vhosts\espirito.org.br\private\db\visitas.mdb;" end if ' Setup guestbook parameters ' page numbers would be separated by this symbols ' you can insert images etc... gb_pageSeparator=" " gb_pageSeparatorLong=" ... " ' Head background gb_colorHead="660000" ' Message background gb_colorMessage="FFFFEE" ' Head font gb_fontHead="" ' Message font gb_fontText="" ' Font used in navigation etc... gb_fontTool="" ' Close font tag gb_fontEnd="" ' Collect guestbook output and process forms gb_text=gb_init(connection_string) %> Livro de Visitas do Portal do Espírito

Portal do Espírito

Mapa do Site | Pesquisa no Site

Página principal » Livro de Visitas

Livro de Visitas

<% Response.Write(gb_text) ' Output guestbook code %>

Página principal | Mapa do Site | Pesquisa no Site

" gb_Write2 s,"Edit record" s=s & "
" gb_Write2 s,"Nome:" s=s & "	" s=s & "
" gb_Write2 s,"Local:" s=s & "	" s=s & "
" gb_Write2 s,"Email:" s=s & "	" s=s & "
" gb_Write2 s,"Mensagem:" s=s & "	" & r("text1") & "" s=s & "
" gb_Write2 s,"Reply:" s=s & "	" & r("resp") & "" s=s & "
" s=s & "

" gb_Write2 s,"Ver o Livro de Visitas * Ajuda" s=s & "
" gb_Write2 s,"Por favor, preencha todos os campos." s=s & "
" gb_Write2 s,"Nome:" s=s & "
" gb_Write2 s,"Email:" s=s & "
" gb_Write2 s,"Local:" s=s & "
" gb_Write2 s,"Mensagem:" s=s & "
" s=s & " " s=s & "" s=s & "