<%=webname%>

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> <%dim time1,time2 time1=timer 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="../images/bgbg.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=1 '是否显示首页，浮动动画， 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 %>

> <% '主程序 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() case "manageusr" call manageusr() End Select %>

<% '添加一条新留言 %> <% 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" and session("flag")<1 Then %> 基本设置 <%end if%> <% If Session("Admin")="Login" and session("flag")<1 Then %> 用户管理 <%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 <% if webyn=1 and rs("view")=0 and session("admin")="" then %><% else%>

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

发表于:<%=year(Rs("date"))%>年<%=month(Rs("date"))%>月<%=day(Rs("date"))%>日 <% if len(trim(rs("web")))>8 then %> 网址:<%=rs("web")%> <% end if %> <% if len(trim(rs("email")))>6 then %> EMAIL:<%=rs("email")%> <% end if %>
<% if len(trim(Rs("come")))>1 then %> 来自:<%=rs("come")%> <% end if %> QQ:<%=rs("qq")%> <% if rs("sex")=1 then %> 性别:男 <% elseif rs("sex")=0 then%> 性别:女<%end if%> <% If Session("Admin") = "Login" and session("flag")<1 Then %> ">

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

<% end if %>

<% if webyn=1 and rs("view")=0 and session("admin")="" then%> 留言需要经过审批才能查看 <%elseif webyn=1 and rs("view")=1 then%> <%=Ubb(unHtml(words))%> <% if len(trim(reply))>1 then%>

站长回复
<%=Ubb(unHtml(reply))%> <%end if %> <%elseif session("admin")<>"" then%> <%=Ubb(unHtml(words))%> <% if len(trim(reply))>1 then%>

站长回复
<%=Ubb(unHtml(reply))%> <%end if %> <%end if %>

<% end if%>
<% 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.sinvo.com/aaa.jpg	[/img]
[url]	这里填写连接地址 http://www.sinvo.com/	[/url]
[swf]	这里填写SWF文件的地址http://www.sinvo.com/yanshi.swf	[/swf]
[email]	这里填写电子信箱地址waixingpeople@126.com	[/email]
[color=颜色]	这里填写要着色的文字	[/color]
[size=大小]	这里填写要加大的文字	[/size]
[font=字体]	这里填写要改变字体的文字	[/font]

<%End Sub%>

<%Sub EditPWD()%> <% If Session("Admin")="" Then Response.Write "连接超时,请重新登录" Response.End end if %>

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

<%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 %> <%Sub manageusr()%> <%set rs=server.CreateObject("adodb.recordset") rs.Open "select * from admin order by flag asc",conn,1,1 do while not rs.EOF%> "> <%rs.movenext loop rs.close set rs=nothing %>

后台管理员设置
管理员	密码	权限	操作
">		<%select case rs("flag") case "1" response.Write "管理查看" case "3" response.Write "管理查看" end select%>	&action=del" onClick="return confirm('您确定要删除此用户吗？')">删除

添加管理员
管理员	密码	权限	操作
		管理查看

<%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 where username='"&username&"' and password='"&password&"'" Rs.Open Sql,Conn,1,1 If not rs.eof 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,"