<%=webname%>

<%@language="vbscript" codepage="936"%> <%dim time1,time2 time1=timer '''''''##################################################################### '''''''# 精点留言本 v1.2 (xp清爽版) http://www.jd100.net/ # '''''''##################################################################### dim page,indexfilename,indeximg,db,n,x,bookbg,txt,jd100_top,jd100_foot,m,jd100_fla indexfilename=right(request.servervariables("path_translated"),(len(request.servervariables("path_translated"))-instrrev(request.servervariables("path_translated"),"\"))) imdeximg="img/" '图片文件夹 db="jd100.mdb" '数据库 set conn=server.createobject("adodb.connection") conn.open "driver={microsoft access driver (*.mdb)};dbq=" & server.mappath(db) n=10 '每页显示留言数 x=5 '每页显示的页数 m=10 '留言头像可选个数,男101-199.gif 女001-099.gif,各可增加到99个 bookbg="bookbg.gif" '背景图片,当不使用背景图时,保持为空 "" txt=1000 '留言的最大字数 jd100_top="

" '设置页头信息welcome.gif可换成你的logo放在图片目录下 dim webtitle,webname,webyn,webgl,webyn2,view2 set rs1 = conn.execute("select * from admin") webtitle=rs1("title") if rs1("webname")<>"" then webname=rs1("webname") if rs1("gbyn")<>"" then webyn=rs1("gbyn") webgl=rs1("gl") rs1.close set rs1=nothing '设置页脚信息,这里可以加入你的地址 jd100_foot="版权所有(c)："& webname &"
"& "本留言本言论纯属发表者个人意见，与 " & webname &" 立场无关" jd100_fla=0 '是否显示首页，浮动动画， 1 显示， 0 不显示 page =request.querystring("page") if page="" or page=0 then page=1 action = request.querystring("action") action_e = request.form("action_e") if action_e <>"" then server_v1=cstr(request.servervariables("http_referer")) server_v2=cstr(request.servervariables("server_name")) if mid(server_v1,8,len(server_v2))<>server_v2 then response.write "

" response.write "

" response.write "你提交的路径有误，禁止从站点外部提交数据请不要乱该参数！" response.write "

" response.end end if end if %> <%=webname%> <% if len(bookbg)<3 then bookbg="" else bookbg="background="& imdeximg & bookbg end if %>

<%=jd100_top%>

> <% '主程序 select case action_e case "" case "add_new" call add_new_execute() case "reply" call reply_execute() case "admin" call admin_login_execute() case "editpwd" call editpwd_execute() case "edit" call edit_execute() case "edit_web" call edit_web() end select call main_menu() select case action case "ubbhelp" call ubbhelp() case "admin_login" call admin_login() case "exit" call exit_admin() call view_words() case "" call view_words() case "add_new" call add_new() case "reply" call reply() case "view_words" call view_words() case "delete" call delete() call view_words() case "editpwd" call editpwd() case "edit" call edit() case "edit_web" call edit_web() end select %>

<%=jd100_foot%>

<% '添加一条新留言 %> <% sub add_new() %>

留　言
姓名：	*10个字内	选择头像:
性别：
qq：
主页：
来自：
电子邮箱：	*
	<% call ubb_jd100() %>
留言内容：	*
	最多字数：> 已用字数：剩余字数：>

<% end sub %> <% sub main_menu() %>

ubb帮助 <% if session("admin")="login" then %> 退出管理 <% else %> 管理留言 <% end if %> <% if session("admin")="login" then %> 基本设置修改密码 <% end if %>

<% end sub ''''''''''''''''''''''' '查看留言 sub view_words() dim gbcount,y,j,k set rs = conn.execute("select count(*) as gbcount from words") gbcount=rs("gbcount") rs.close if gbcount/n = int(gbcount/n) then '计算出分页数 y=int(gbcount/n) else y=int(gbcount/n)+1 end if page2= int(page/x) if page/x>page2 then page2=page2+1 k=page2*x if k>y then k=y '打开留言字段' if page=1 then sql="select top "&n&" id,name,sex,head,web,email,title,words,date,reply,ip,come,view,qq from words order by id desc" else sql="select id,name,sex,head,web,email,title,words,date,reply,ip,come,view,qq from words order by id desc" end if if page >100 then rs.open sql,conn,1 else set rs=conn.execute(sql) end if if page>1 then rs.move n*page-n %> <% if len(webtitle)>2 then %> <% end if %>

有<%=gbcount %>条留言 <%=page %>/<%=y %>页分页 << <% if page2>1 then %> < <% end if %> <% for m =page2*x-(x-1) to k %> [<%=m%>] <% next %> <% if page2*x < y then %> > <% end if %> >>

<%=webtitle %>

<% if rs.bof and rs.eof then response.write "当前没有留言记录" %> <% dim lou,words,reply,email,qq,web,come if request.querystring("page")<2 then lou=gbcount else lou=gbcount-((request.querystring("page")-1)*n) end if i=0 do while not rs.eof and i

tt_bg.gif>

留言者:<%=rs("name")%>

发表于:<%=year(rs("date"))%>年<%=month(rs("date"))%>月<%=day(rs("date"))%>日 <% if len(trim(rs("web")))>8 then %> " target="_blank"> 我的主页是:<%=rs(

" width=16 height=16 border="0"> <% end if %> <% if len(trim(rs("email")))>6 then %> "> 我的email是:<%=rs(

" width="16" height="16" border="0"> <% end if %> <% if len(trim(rs("qq")))>3 then %> 我的qq号:<%=rs(

" width="16" height="16" border="0"> <% end if %> <% if len(trim(rs("come")))>1 then %> 我来自:<%=rs(

" width="16" height="16"> <% end if %> <% if session("admin") = "login" then %>

<%=rs("ip")%> ">

" onclick="return confirm('确定要删除吗？\n\n该操作不可恢复！')">

<% end if %>

第 <%=lou %> 条留言

<%if rs("head")="" then %> <%if rs("sex")=1 then %>

<% else %>

<% end if %> <% else %>

.gif"> <% end if %>

<% if webyn=1 and rs("view")=1 then %> <%=ubb(unhtml(words))%> <% if len(trim(reply))>1 then%>

斑竹回复:
<%=ubb(unhtml(reply))%> <%end if %> <%end if %> <% if webyn<>1 then %> <%=ubb(unhtml(words))%> <% if len(trim(reply))>1 then%>

斑竹回复:
<%=ubb(unhtml(reply))%> <%end if %> <%end if %> <% if webyn=1 and rs("view")=0 then%> 留言需要经过审批才能查看 <%end if %>

t_bottombg.gif>

<% lou=lou-1 rs.movenext loop rs.close set rs = nothing %>

有<%=gbcount %>条留言 <%=page %>/<%=y %>页分页 << <% if page2>1 then %> < <% end if %> <% for m =page2*x-(x-1) to k %> [<%=m%>] <% next %> <% if page2*x < y then %> > <% end if %> >>

<% end sub %> <% '''''''''管理员登陆接口 %> <% sub admin_login() dim num1 dim rndnum randomize do while len(rndnum)<4 num1=cstr(chr((57-48)*rnd+48)) rndnum=rndnum&num1 loop session("jd100_rn")=rndnum %>

管理登陆

用户名：

密码：

输入验证码：

<%=session("jd100_rn")%>

<% end sub%> <% ''''''''''' %> <%sub ubbhelp()%>

ubb功能帮助
[img]	这里填写图片的绝对地址如 http://www.jd100.net/aaa.jpg	[/img]
[url]	这里填写连接地址 http://www.jd100.net/	[/url]
[swf]	这里填写swf文件的地址http://www.jd100.net/yanshi.swf	[/swf]
[email]	这里填写电子信箱地址kx1999@21cn.com	[/email]
[color=颜色]	这里填写要着色的文字	[/color]
[size=大小]	这里填写要加大的文字	[/size]
[font=字体]	这里填写要改变字体的文字	[/font]

<%end sub%>

<%sub editpwd()%>

修改密码
旧用户名：
新用户名：
确认新用户名：
旧密码：
新密码：
确认新密码：

<%end sub%> <% sub edit() %> <% sql="select * from words where id="&request.querystring("id") set rs=conn.execute(sql) view2="" if rs("view")=1 then view2="checked" end if %>

编辑留言内容及回复
留言者：	网名:<%=rs("name")%> 性别: <%if rs("sex")=1 then response.write "男" else response.write "女" end if%> 来自:<%=rs("come")%> 时间:<%=rs("date")%> ip:<%=rs("ip")%>
邮箱：	<%=rs("email")%>
留言内容：修改原文	<%=rs("words")%>
	<% call ubb_jd100() %>
回复：	<%=rs("reply")%> <% if webyn=1 then%> > 通过审批 <% end if %>
"> 　　返回

<% rs.close set rs=nothing end sub %>
<% sub edit_web() %> <% if request.form("submit")="修改" then set rs = server.createobject("adodb.recordset") sql="select * from admin" rs.open sql,conn,2,3 rs("title")=request.form("webtitle") rs("gl")=request.form("webggg") rs("gbyn")=cint(request.form("webyn")) rs("webname")=request.form("webname") rs.update rs.close set rs=nothing response.redirect indexfilename &"?action=edit_web" response.end end if webyn2="" if webyn=1 then webyn2="checked" end if %>

编辑留言板属性
留言板名称
公告内容：	<%=webtitle%>
词语过滤：
经过审批才显示留言：	> 是
返回

<% end sub %> <% if jd100_fla=1 then if request("action")="view_words" or request("action")="" then %>

<% end if end if %> <% sub ubb_jd100()%>

字体大小颜色： <% end sub %> <% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '添加新留言到数据库 sub add_new_execute() '不良词语过滤 if trim(request.form("name"))="" then response.write("") response.end end if if len(request.form("name"))>20 then response.write("") response.end end if if request.form("email")<>"" then if instr(request.form("email"),"@")=0 or instr(request.form("email"),"@")=1 or instr(request.form("email"),"@")=len(email) then response.write("") response.end end if end if if trim(request.form("words"))="" then response.write("") response.end end if set rs = server.createobject("adodb.recordset") sql="select * from words" rs.open sql,conn,2,3 rs.addnew rs("name")=server.htmlencode(request.form("name")) rs("sex")=server.htmlencode(request.form("sex")) rs("head")=server.htmlencode(request.form("head")) rs("web")=server.htmlencode(request.form("web")) rs("email")=server.htmlencode(request.form("email")) rs("words")=server.htmlencode(request.form("words")) rs("qq")=server.htmlencode(request.form("qq")) rs("head")=server.htmlencode(request.form("img")) rs("date")=now() rs("ip")=request.servervariables("remote_addr") rs("come")=server.htmlencode(request.form("come")) rs.update rs.close set rs = nothing end sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '验证管理员登陆 sub admin_login_execute() username = server.htmlencode(request.form("username")) password = server.htmlencode(request.form("password")) if trim(server.htmlencode(request.form("jd100rz")))<>session("jd100_rn") then response.write("") response.end end if session("jd100_rn")="" if username = "" or password = "" then response.write "用户名或者密码为空" response.end end if set rs = server.createobject("adodb.recordset") sql="select * from admin" rs.open sql,conn,1,1 if username = rs("username") and password = rs("password") then session("admin") = "login" else response.write "用户名或者密码不对，登陆失败" end if rs.close set rs = nothing end sub sub editpwd_execute() if session("admin")="" then response.write "连接超时,请重新登录" response.end end if oldusername=server.htmlencode(request.form("oldusername")) username = server.htmlencode(request.form("username")) username_c = server.htmlencode(request.form("username_c")) oldpwd = server.htmlencode(request.form("oldpwd")) newpwd = server.htmlencode(request.form("newpwd")) newpwd_c = server.htmlencode(request.form("newpwd_c")) if username = "" or username_c="" then response.write "新旧用户名均不能为空" response.end end if if oldpwd = "" or newpwd = "" or newpwd_c="" then response.write "新旧密码均不能为空" response.end end if if username<>username_c then response.write "新填写的两个新用户名不一致，请重新填写" response.end end if if newpwd<>newpwd_c then response.write "新填写的两个密码不一致，请重新填写" response.end end if set rs = server.createobject("adodb.recordset") sql="select * from admin" rs.open sql,conn,2,3 if rs("password")=oldpwd and rs("username")=oldusername then rs("username")=username rs("password")=newpwd rs.update else response.write "你的旧密码填写不对或者旧用户名不对，修改不成功" response.end end if rs.close set rs = nothing end sub sub exit_admin() session.abandon response.redirect indexfilename end sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '删除数据 sub delete() if session("admin")="" then response.write "连接超时,请重新登录" response.end end if '删除数据 conn.execute("delete * from words where id="&request.querystring("id")) end sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '回复留言添加到数据库 sub reply_execute() if session("admin")="" then response.write "连接超时,请重新登录" response.end end if set rs = server.createobject("adodb.recordset") sql="select reply from words where id="&request.form("id") rs.open sql,conn,2,3 rs("reply") = server.htmlencode(request.form("reply")) rs.update rs.close set rs=nothing end sub sub edit_execute() if session("admin")="" then response.write "连接超时,请重新登录" response.end end if set rs = server.createobject("adodb.recordset") sql="select * from words where id="&request.form("id") rs.open sql,conn,2,3 if cint(request.form("replyedit"))=1 then rs("words") = server.htmlencode(request.form("reply")) end if rs("reply") = server.htmlencode(request.form("words")) if cint(request.form("view"))=1 then rs("view")=1 else rs("view")=0 end if rs.update rs.close set rs=nothing end sub conn.close set conn = nothing %> <% function unhtml(content) unhtml=content if content <> "" then 'unhtml=replace(unhtml,"&","&") unhtml=replace(unhtml,"<","<") unhtml=replace(unhtml,">",">") unhtml=replace(unhtml,chr(34),""") unhtml=replace(unhtml,chr(13),"
") unhtml=replace(unhtml,chr(32)," ") unhtmlgl=split(webgl,"|") if isarray(unhtmlgl) then for i=0 to ubound(unhtmlgl) unhtml=replace(unhtml,unhtmlgl(i),"***") next end if 'unhtml=ubb(unhtml) end if end function function ubb(content) ubb=content nowtime=now() ubb=convert(ubb,"code") ubb=convert(ubb,"html") ubb=convert(ubb,"url") ubb=convert(ubb,"color") ubb=convert(ubb,"font") ubb=convert(ubb,"size") ubb=convert(ubb,"quote") ubb=convert(ubb,"email") ubb=convert(ubb,"img") ubb=convert(ubb,"swf") ubb=convert(ubb,"cen") ubb=convert(ubb,"rig") ubb=convert(ubb,"lef") ubb=convert(ubb,"center") ubb=autourl(ubb) ubb=replace(ubb,"[b]","",1,-1,1) ubb=replace(ubb,"[/b]","",1,-1,1) ubb=replace(ubb,"[i]","",1,-1,1) ubb=replace(ubb,"[/i]","",1,-1,1) ubb=replace(ubb,"[u]","",1,-1,1) ubb=replace(ubb,"[/u]","",1,-1,1) ubb=replace(ubb,"[blue]","",1,-1,1) ubb=replace(ubb,"[/blue]","",1,-1,1) ubb=replace(ubb,"[red]","",1,-1,1) ubb=replace(ubb,"[/red]","",1,-1,1) for i=1 to 28 ubb=replace(ubb,"{:em"&i&"}","

",1,6,1) ubb=replace(ubb,"{:em"&i&"}","",1,-1,1) next ubb=replace(ubb,"["&chr(176),"[",1,-1,1) ubb=replace(ubb,chr(176)&"]","]",1,-1,1) ubb=replace(ubb,"/"&chr(176),"/",1,-1,1) ' ubb=replace(ubb,"{;em","{:em",1,-1,1) end function function convert(ubb,covt) ctext=ubb startubb=1 do while covt="url" or covt="color" or covt="font" or covt="size" startubb=instr(startubb,ctext,"["&covt&"=",1) if startubb=0 then exit do endubb=instr(startubb,ctext,"]",1) if endubb=0 then exit do lcovt=covt startubb=startubb+len(lcovt)+2 text=mid(ctext,startubb,endubb-startubb) codetext=replace(text,"[","["&chr(176),1,-1,1) codetext=replace(codetext,"]",chr(176)&"]",1,-1,1) 'codetext=replace(codetext,"{:em","{;em",1,-1,1) codetext=replace(codetext,"/","/"&chr(176),1,-1,1) select case covt case "color" ctext=replace(ctext,"[color="&text&"]","",1,1,1) ctext=replace(ctext,"[/color]","",1,1,1) case "font" ctext=replace(ctext,"[font="&text&"]","",1,1,1) ctext=replace(ctext,"[/font]","",1,1,1) case "size" if isnumeric(text) then if text>6 then text=6 if text<1 then text=1 ctext=replace(ctext,"[size="&text&"]","",1,1,1) ctext=replace(ctext,"[/size]","",1,1,1) end if case "url" ctext=replace(ctext,"[url="&text&"]","",1,1,1) ctext=replace(ctext,"[/url]","",1,1,1) case "email" ctext=replace(ctext,"["&covt&"="&text&"]","",1,1,1) ctext=replace(ctext,"[/"&covt&"]","",1,1,1) end select loop startubb=1 do startubb=instr(startubb,ctext,"["&covt&"]",1) if startubb=0 then exit do endubb=instr(startubb,ctext,"[/"&covt&"]",1) if endubb=0 then exit do lcovt=covt startubb=startubb+len(lcovt)+2 text=mid(ctext,startubb,endubb-startubb) codetext=replace(text,"[","["&chr(176),1,-1,1) codetext=replace(codetext,"]",chr(176)&"]",1,-1,1) 'codetext=replace(codetext,"{:em","{;em",1,-1,1) codetext=replace(codetext,"/","/"&chr(176),1,-1,1) select case covt case "center" ctext=replace(ctext,"[center]","

",1,1,1) ctext=replace(ctext,"[/center]","

",1,1,1) case "url" ctext=replace(ctext,"["&covt&"]"&text,""&codetext,1,1,1) ctext=replace(ctext,""&codetext&"[/"&covt&"]",""&codetext&"",1,1,1) case "email" ctext=replace(ctext,"["&covt&"]","",1,1,1) ctext=replace(ctext,"[/"&covt&"]","",1,1,1) case "html" codetext=replace(codetext,"
",chr(13),1,-1,1) codetext=replace(codetext," ",chr(32),1,-1,1) randomize rid="temp"&int(100000 * rnd) ctext=replace(ctext,"[html]"&text,"代码片断如下： ",1,1,1) case "img" '一般显示的图片 ctext=replace(ctext,"[img]"&text,""&chr(34)&" target=_blank> ::点击图片在新窗口中打开::

",1,1,1) case "cen" '图片居中 ctext=replace(ctext,"[cen]"&text,"

"&chr(34)&" target=_blank> ::点击图片在新窗口中打开::

",1,1,1) case "rig" '图片居右,文字绕排 ctext=replace(ctext,"[rig]"&text,""&chr(34)&" target=_blank> ::点击图片在新窗口中打开::

",1,1,1) case "lef" '图片居左,文字绕排 ctext=replace(ctext,"[lef]"&text,""&chr(34)&" target=_blank> ::点击图片在新窗口中打开::

",1,1,1) case "code" ctext=replace(ctext,"[code]"&text,"以下内容为程序代码

"&codetext,1,1,1) ctext=replace(ctext,"以下内容为程序代码

"&codetext&"[/code]","以下内容为程序代码

"&codetext&"

",1,1,1) case "quote" atext=replace(text,"[cen]","",1,-1,1) atext=replace(text,"[/cen]","",1,-1,1) atext=replace(text,"[img]","",1,-1,1) atext=replace(atext,"[/img]","",1,-1,1) atext=replace(atext,"[swf]","",1,-1,1) atext=replace(atext,"[/swf]","",1,-1,1) atext=replace(atext,"[html]","",1,-1,1) atext=replace(atext,"[/html]","",1,-1,1) ' atext=replace(atext,"{:em","{;em",1,-1,1) atext=splitwords(atext,350) atext=replace(atext,chr(32)," ",1,-1,1) ctext=replace(ctext,"[quote]"&text,"

"&atext,1,1,1) ctext=replace(ctext,"
"&atext&"[/quote]","
"&atext&"
",1,1,1) case "swf" ctext=replace(ctext,"[swf]"&text,"