<% '判断是否支持UBB if ubb = "on" then DisUBB = 0 else DisUBB = 1 end if '引用开关 if quote = "on" then DisQut = 0 else DisQut = 1 end if '可以使用html语法吗 tagset = "off" '可以使用贴图语法吗 if tagimg = "on" then DisIMG = 0 else DisIMG = 1 end if '可以使用媒体语法吗 if tagmda = "on" then DisMda = 0 else DisMda = 1 end if '可以使用字型语法吗 if tagfnt = "on" then DisFnt = 0 else DisFnt = 1 end if '导入模板 function template(file) path=server.mappath(file) set fileobject=server.createobject("scripting.filesystemobject") set textfile=fileobject.opentextfile(path) while not textfile.atendofstream template=(textfile.readall) wend textfile.close end function '判断是否回复 Dim SQLFiltrate IF IsInteger(Request.QueryString("id"))=True Then SQLFiltrate="where id="&Request.QueryString("id")&"" End IF '搜索 if Request.QueryString("action")="search" then if request("keyword")="" then response.Redirect "index.asp" end if if request("keytype")="" then keytype="name" else keytype=request("keytype") end if SQLFiltrate="where "&keytype&" like '%"&request("keyword")&"%'" end if '选择提交方式 select case Request.QueryString("action") case "res" action="res" case "add_edit" action="add_edit" case "res_edit" action="res_edit" case else action="add" end select '提交ID If Request.QueryString("id")<>"" then myid=Request.QueryString("id") Else myid="" End If '提取cookies dim cook_name,cook_email,cook_home cook_name = request.cookies(cookiename)("name") cook_mail = request.cookies(cookiename)("mail") cook_url = request.cookies(cookiename)("url") cook_icon = request.cookies(cookiename)("icon") If request.cookies(cookiename)("icon")=Empty then cook_icon = "01.gif" End If '列出留言 Dim mes,SQLm Set mes=Server.CreateObject("Adodb.Recordset") If new_res_top="off" then SQLm="select * from message "&SQLFiltrate&" order by top desc" else SQLm="select * from message "&SQLFiltrate&" order by top,lasttime desc" end if mes.Open SQLm,CONN,1,1 '分页 CurrentPage = 0 If mes.PageCount > 0 Then mes.PageSize = dataout CurrentPage = Request("page") If (CurrentPage - mes.PageCount)>0 Then CurrentPage = mes.PageCount Else If CurrentPage = "" or CurrentPage < 1 Then CurrentPage = 1 End If mes.AbsolutePage = CurrentPage End If '取出记录 If mes.EOF AND mes.BOF Then Else TotalMsg=mes.RecordCount Dim ID,name,pwd,mail,url,icon,message,time,ip,top,recount,lasttime Dim flag,nNum flag=0 DO While not mes.EOF ID=mes("ID") name=mes("name") pwd=mes("pwd") mail=mes("mail") url=mes("url") icon=mes("icon") message=Ubbcode(mes("message"),DisUBB,DisIMG,DisMda,DisFnt,DisQut) time=mes("time") ip=mes("ip") top=mes("top") lasttime=mes("lasttime") '判断回复按钮样式 Dim sres,resbtn If resimage<>"" then sres="" Else sres=""&restext&"" End if '判断可否回复 If res_sort="on" then resbtn = sres else resbtn = "" end if if pwd<>"" then '判断编辑按钮样式 Dim sedit If editimage<>"" then sedit="" Else sedit=""&edittext&"" End if '判断可否编辑 If guestedit="on" then edit = sedit else edit = "" end if else' edit = "" end if '判断邮箱图标样式 Dim mmail,murl If mailimage<>"" then mmail="" Else mmail=""&mailtext&"" End if '判断主页图标样式 If urlimage<>"" then murl="" Else murl=""&urltext&"" End if '判断是否显示邮箱 If mail<>"" then mail=mmail Else mail="" End if '判断是否显示主页 If url<>"" then url=murl Else url="" End if '列出回复 Dim res,SQLr Set res=Server.CreateObject("Adodb.Recordset") SQLr="select * from res where message_id="&mes("ID")&"" res.Open SQLr,CONN,1,1 If res.EOF AND res.BOF Then Else Dim res_ID,res_name,res_pwd,res_mail,res_url,res_icon,res_message,res_time,res_ip,res_top,message_id Do Until res.EOF res_ID=res("ID") res_name=res("name") res_pwd=res("pwd") res_mail=res("mail") res_url=res("url") res_icon=res("icon") res_message=Ubbcode(res("message"),DisUBB,DisIMG,DisMda,DisFnt,DisQut) res_time=res("time") res_ip=res("ip") res_top=res("top") message_id=res("message_id") if res_pwd<>"" then '判断编辑按钮样式 Dim redit If editimage<>"" then redit="" Else redit=""&edittext&"" End if '判断可否编辑 If guestedit="on" then res_edit = redit else res_edit = "" end if else res_edit = "" end if '判断邮箱图标样式 Dim rmail,rurl If mailimage<>"" then rmail="" Else rmail=""&mailtext&"" End if '判断主页图标样式 If urlimage<>"" then rurl="" Else rurl=""&urltext&"" End if '判断是否显示邮箱 If res_mail<>"" then res_mail=rmail Else res_mail="" End if '判断是否显示主页 If res_url<>"" then res_url=rurl Else res_url="" End if '导入回复模板 r = template("res.htm") r=replace(r,"",res_id) r=replace(r,"",res_name) r=replace(r,"",res_url) r=replace(r,"",res_mail) r=replace(r,"",res_message) r=replace(r,"",res_edit) r=replace(r,"",res_time) r=replace(r,"",res_icon) r=replace(r,"",message_id) r=replace(r,"",stylecolor) reslist = reslist&r '回复循环 res.MoveNext Loop End If res.Close Set res=Nothing '导入留言模板 m = template("message.htm") m=replace(m,"",id) m=replace(m,"",resbtn) m=replace(m,"",name) m=replace(m,"",url) m=replace(m,"",icon) m=replace(m,"",mail) m=replace(m,"",message) m=replace(m,"",edit) m=replace(m,"",time) m=replace(m,"",reslist) m=replace(m,"",Int(1 + 5 * Rnd)) m=replace(m,"",stylecolor) reslist="" '留言循环 flag=flag+1 If flag>=dataout Then Exit DO meslist = meslist&m mes.MoveNext Loop End If '显示分页 PageHead = CurrentPage - 4 If mes.PageCount > 9 and ( mes.PageCount - CurrentPage ) < 5 Then PageHead = mes.PageCount - 9 If mes.PageCount < 10 and ( mes.PageCount - CurrentPage ) < 5 Then PageHead = 1 If ( CurrentPage - 5 ) < 0 Then PageHead = 1 Dim pageformat pageformat="" pageformat=pageformat&"9" If CurrentPage <= 1 Then pageformat=pageformat&"3 " Else pageformat=pageformat&"3  " End If Dim i for i = 1 to 10 If PageHead = mes.PageCount + 1 Then Exit for If PageHead - CurrentPage = 0 Then pageformat=pageformat&"" & PageHead & "  " Else pageformat=pageformat&"" & PageHead & "  " End If PageHead = PageHead + 1 Next If CurrentPage - mes.PageCount = 0 Then pageformat=pageformat&"4" Else pageformat=pageformat&"4" End If pageformat=pageformat&":" 'mes.PageCount 'dataout mes.Close Set mes=Nothing '导入表单模板 Dim t t = template("main.htm") t=replace(t,"",board_name) t=replace(t,"",siteurl) t=replace(t,"",stylecolor) t=replace(t,"",action) t=replace(t,"",myid) t=replace(t,"",cook_name) t=replace(t,"",cook_mail) t=replace(t,"",cook_url) t=replace(t,"",cook_icon) t=replace(t,"",cook_pass) t=replace(t,"",maxlength) t=replace(t,"",meslist) t=replace(t,"",pageformat) response.write t set t = nothing '删除动作 If Request.QueryString("action")="delete" then if request.form("master_pwd")=master_pwd then dim getid,del_id,del_message_id getid = split(trim(request.form("id")),",") for each str in getid varstr = split(str,"|") del_id = varstr(0) del_message_id = varstr(1) if del_message_id = 0 then conn.execute("delete from message where id="&del_id&"") conn.execute("delete from res where message_id="&del_id&"") else conn.execute("delete from res where id="&del_id&"") end if next else end if response.redirect "index.asp" else end if '全部结束 conn.Close Set conn=Nothing %>