<%dim time1,time2,Conn 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="images/" '图片文件夹 db="images/guestbook.mdb" '数据库 set Conn=Server.CreateObject("ADODB.Connection") dim sqlstr,conStr connstr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(db) Conn.Open connstr 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 '设置页脚信息,这里可以加入你的地址 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 %> Message Board 高密银鹰科技有限公司 <% 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() if action <> "Admin_Login" and action_e="" then Call Add_New() end if Select Case action Case "UbbHelp" Call UbbHelp() Case "Admin_Login" Call Admin_Login() Case "Exit" Call Exit_Admin() Call View_Words() Case "" if Session("Admin") = "Login" then Call View_Words() end if 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 %> <% '添加一条新留言 %> <% Sub Add_New() %>
Please Leave Your Message
您的名字:
*in ten words
您所在的公司:
邮箱: *
<% call ubb_jd100() %>
留言内容: *
  Max Word:> use: left:>


<% End Sub %> <% Sub Main_Menu() %>
<% 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 %> >>
<% 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()%>
<%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")%>
留言内容:

修改原文
  <% call ubb_jd100() %>
回复:
<% 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 %>
编辑留言板属性
留言板名称
公告内容:
词语过滤:
经过审批才显示留言: > 是
  返回
<% 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("view")=1 Rs("date")=Now() Rs("ip")=request.servervariables("remote_addr") Rs("come")=Server.HTMLEncode(Request.Form("come")) Rs.Update Rs.Close Set Rs = Nothing Response.Write("") 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,"",1,1,1) cText=replace(cText,""&"[/swf]",""&"",1,1,1) end select loop Convert=cText end function function AutoURL(ubb) cText=ubb startubb=1 do startubb=1 endubb_a=0 endubb_b=0 endubb=0 startubb=instr(startubb,cText,"http://",1) if startubb=0 then exit do endubb_b=instr(startubb,cText,"<",1) endubb_a=instr(startubb,cText," ",1) endubb=endubb_a if endubb=0 then endubb=endubb_b end if if endubb_b0 then endubb=endubb_b end if if endubb=0 then lenc=ctext endubb=len(lenc)+1 end if 'response.write startubb&","&endubb if startubb>endubb then exit do text=mid(cText,startubb,endubb-startubb) 'response.write text 'codetext=replace(text,"/","/"&chr(176),1,-1,1) codetext=text 'response.write text&"," urllink=""&codetext&" " 'response.write urllink urllink=replace(urllink,"/","/"&chr(176),1,-1,1) cText=replace(cText,text,urllink,1,1,1) loop AutoURL=cText end function %>

COPYRIGHT © 2013-2014 yyingtech.com 高密银鹰科技有限公司. All rights reserved.